vba编程 变量赋值单元格

Posted 2023-05-01

比如 变量＝"资产"
单元格＝变量
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim i As Integer
Dim j As Integer
Dim zcbh As Variant
Dim ytzj As Variant
Dim sh As Worksheet
For i = 3 To 10
zcbh = Sheet8.Cells(i, 3).Value
Sheet6.Activate
Sheet6.Columns(2).Find(what:= zcbh).Activate
Sheet6.Columns(7).Active
Yjzj = Activecell.value
Sheet8.Activate
Sheet8.Cells(I,8).Value = ytzj
Next i
MsgBox "程序运行完毕"
Application.ScreenUpdating = True
End Sub

上述程序中，先在表8中取得ZCBH，到表6中查找，找到后把第7列的数值赋给ytzj,再回到第表8中，为ZCBH所在的行的第8列赋值。现在是ytzj的值赋不到表8的单元格中，不知是什么原因。请帮助看一下这段程序的错误，谢谢！
-------------------------
运行3楼程序时，说错误91，对象变量或with块变量未设置，这是什么原因？
sh6.Columns(2).Find(what:=zcbh).Activate就这句话。错误91。

sub aa()
dim x as string
x="资产"
cells(m,n)=x 'm代表行标，m代表列标，根据不同情况可以用数字代替。
end sub

如果不是给当前工作表赋值，可以用以下格式
Sheets("Sheet1").range("B2")=100 '把100赋值给sheet1工作表中的B2单元格

也可以给某一个区域赋值：
range("A1:A100").select
Selection=100

Selection就可以标识当前选中的单元格,上面2句代码是将当前选中的单元格写入100.

程序可改为下面代码
Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim i As Integer
Dim j As Integer
Dim zcbh As Variant
Dim ytzj As Variant
Dim yjzj As Variant
Dim sh As Worksheet
For i = 3 To 10
zcbh = Sheets("8").Cells(i, 3)
Sheets("6").Activate
Sheets("6").Columns(2).Find(what:=zcbh).Activate
ActiveCell.Offset(0, 5).Select
yjzj = ActiveCell.Value
Sheets("8").Activate
Sheets("8").Cells(i, 8).Value = ytzj
Next i
MsgBox "程序运行完毕"
Application.ScreenUpdating = True
End Sub

修改为以下代码：
Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim i As Integer
Dim j As Integer
Dim zcbh As Variant
Dim ytzj As Variant
Dim yjzj As Variant
Dim sh6 As Worksheet
Dim sh8 As Worksheet
Set sh6 = ThisWorkbook.Sheets("sheet6")
Set sh8 = ThisWorkbook.Sheets("sheet8")
For i = 3 To 10
zcbh = sh8.Cells(i, 3)
sh6.Activate
sh6.Columns(2).Find(what:=zcbh).Activate
ActiveCell.Offset(0, 5).Select
ytzj = ActiveCell.Value
sh8.Cells(i, 8) = ytzj
Next i
MsgBox "程序运行完毕"
Application.ScreenUpdating = True
End Sub 参考技术A Sheets(1).Cells(X, Y) = 变量 'sheet(1)代表第一个工作表。Cells(X, Y)代表X行Y列单元格。
或
Sheets(1).Range("A1") = 变量 'Range("A1") 代表"a1"单元格。 参考技术B Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim i As Integer
Dim j As Integer
Dim zcbh As Variant
Dim ytzj As Variant
Dim sh As Worksheet
For i = 3 To 10
zcbh = Sheet8.Cells(i, 3).Value
Sheet6.Activate
Sheet6.Columns(2).Find(what:=zcbh).Activate
ActiveCell.Offset(0, 6).Select '第2列向后偏移6列，即H列
ytzj = Selection.Value
Sheet8.Activate
Sheet8.Cells(i, 8).Value = ytzj
Next i
MsgBox "程序运行完毕"
Application.ScreenUpdating = True
End Sub 参考技术C cells(x,y).value=变量
或者range("A1").value=变量

EXCEL VBA为多个变量赋值

【中文标题】EXCEL VBA为多个变量赋值

【英文标题】：EXCEL VBA assigning values to multiple vairables

【发布时间】：2017-08-01 01:20:23

【问题描述】：

您好，我正在尝试将值从 excel 插入 mysql 数据库。所以我的价值观是一致的。每行大约 20+ 个单元格。并且每个单元格必须输入到数据库中的特定列。

我需要的是我所拥有的简化代码。

SQLStr = "INSERT INTO submitteddrawings(Team,Name,MgtNo,JobNo,DrawingNo,Status,Version,SubMo,DwgSheet,ReusedDwg,PCChecked, N1A,N1B,N1C,N1D,N2A,N2B,N2C,N2D,N3A,N3B,N3C,N3D,N3E,N4A,N4B,N4C,N4D,N4E,N5A,N5B,N5C,N5D,N6,J1A,J1B,J1C,J2A,J2B,J2C,J2D,J2E,J3A,J3B,J3C,J3D,J3E,J3F,J3G) VALUES ('" & e & "', '" & f & "','" & g & "','" & h & "','" & i & "','" & j & "','" & k & "','" & l & "','" & m & "','" & n & "','" & o & "','" & p & "','" & q & "','" & r & "','" & s & "','" & t & "','" & u & "','" & v & "','" & w & "','" & x & "','" & y & "','" & z & "','" & aa & "','" & ab & "','" & ac & "','" & ad & "','" & ae & "','" & af & "','" & ag & "','" & ah & "','" & ai & "','" & aj & "', '" & ak & "','" & al & "','" & am & "','" & an & "','" & ao & "','" & ap & "','" & aq & "','" & ar & "','" & ass & "','" & at & "','" & au & "','" & av & "','" & aw & "','" & ax & "','" & ay & "','" & az & "','" & ba & "','" & bb & "','" & bc & "','" & bd & "')"

正如所见，有很多刺激眼睛的变量。 TIA

【问题讨论】：

您可以（并且应该）为插入使用准备好的语句。这至少会摆脱那些无处不在的单个连接引号。为了进一步简化，如果您为 MySQL 表中的每一列分配值，您也可以消除列名，尽管将它们留在那里可能更安全。

感谢您的额外想法。所以基本上这是我们可以拥有的唯一和最简单的方法？循环是一种可能的选择吗？

当然你可以循环，如果你的插入逻辑允许的话。但是，如果您只是说 10 个没有关系的临时插入，那么您将需要这 10 个插入的代码。

先生，您能提供循环样本吗？抱歉，我对此很陌生。老实说，我什至不知道 ad-hoc 是 LOL

我不知道 VBA，但即使我知道，我也不能给你一个循环，因为你从来没有给我们你想要插入的逻辑。阅读 VBA 中准备好的语句，Stack Overflow 是一个很好的起点。

【参考方案1】：

尝试了解以下内容 - 为连续的特定范围创建字符串。这只是在 Excel 中为特定范围生成 SQL 语句的众多方法中的一种。

Option Explicit

Private Function GetInsertStatementForRowRange(InputRange As Range) As String
    Dim SQLStr As String, sValues As String, oRng As Range
    Const INSERT_BASE As String = "INSERT INTO submitteddrawings(Team,Name,MgtNo,JobNo,DrawingNo,Status,Version,SubMo,DwgSheet,ReusedDwg,PCChecked,N1A,N1B,N1C,N1D,N2A,N2B,N2C,N2D,N3A,N3B,N3C,N3D,N3E,N4A,N4B,N4C,N4D,N4E,N5A,N5B,N5C,N5D,N6,J1A,J1B,J1C,J2A,J2B,J2C,J2D,J2E,J3A,J3B,J3C,J3D,J3E,J3F,J3G) VALUES (<VALUES>)"
    sValues = ""
    For Each oRng In InputRange.Cells
        If Len(sValues) > 0 Then sValues = sValues & ", "
        sValues = sValues & "'" & oRng.Value & "'"
    Next
    SQLStr = Replace(INSERT_BASE, "<VALUES>", sValues)
    GetInsertStatementForRowRange = SQLStr
End Function

Sub SO45427529()
    Dim lRow As Long
    Const COLS_BASE As String = "E<R>:BD<R>"
    ' Below example is just for columns E to BD on row 2 of ActiveSheet
    ' You need to modify the Do-Loop to suit your useful range, assuming stop when it's empty
    lRow = 7 ' Start from row 7
    Do Until IsEmpty(Cells(lRow, "E"))
        ' Observe the output in Immediate Window
        Debug.Print "Row " & lRow, GetInsertStatementForRowRange(Range(Replace(COLS_BASE, "<R>", lRow)))
        lRow = lRow + 1
    Loop
End Sub

【参考方案2】：

这里有两个示例说明如何创建函数来包装值。

示例 1：

将行的值转换为一维数组，并使用 Join 创建一个包含各个值的字符串

Function getSingleQuotedValues(Target As Range)
    Dim Data As Variant
    Data = Application.WorksheetFunction.Transpose(Target.Value)
    Data = Application.WorksheetFunction.Transpose(Data)
    getSingleQuotedValues = "'" & Join(Data, "','") & "'"
End Function

示例 2 MYSQL：

通过使用Select Case 语句来决定如何格式化各个列的数据，这将使您在处理值时更加灵活。

输出

'1/2/2009  6:17:00 AM','Product1','1200','Mastercard','carolina','Basildon','England','United Kingdom','1/2/2009  6:00:00 AM','1/2/2009  6:08:00 AM','51.5','-1.1166667','13','14','15','16','17','18','19','20','21','22','23','24','25','26','27','28','29','30','31','32','33','34','35','36','37','38','39','40','41','42','43','44','45','46','47','48','49','50','51','52','53','54','55','56'

---

Function getMySQLValues(Target As Range) As String
    Dim r As Range
    Dim s As String
    For Each r In Target
        Select Case r.Column
            Case 1, 9, 10
                s = s & ",'" & Format(r.Value, "YYYYMMDDHHMMSS") & "'"    'Columns containing Date values
            Case Else
                s = s & ",'" & r.Value & "'"
        End Select
    Next
    getMySQLValues = Right(s, Len(s) - 1)
End Function

奖励获取访问值字符串：

输出

#20090102061700#,'Product1',1200,'Mastercard','carolina','Basildon','England','United Kingdom',#20090102060000#,#20090102060800#,51.5,-1.1166667,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56

---

Function getAccessValues(Target As Range) As String
    Dim r As Range
    Dim s As String
    For Each r In Target
        Select Case r.Column
            Case 2, 4 To 8                            'Columns containing String values
                s = s & ",'" & r.Value & "'"
            Case 1, 9, 10
                s = s & ",#" & Format(r.Value, "yyyy-mm-dd hh:nn:ss") & "#"    'Columns containing Date values
            Case Else                                 'Columns containing Numeric values
                s = s & "," & r.Value
        End Select
    Next
    getAccessValues = Right(s, Len(s) - 1)
End Function

测试

Sub Test()
    Dim x As Long

    With Worksheets("Data")
        Debug.Print "Test getSingleQuotedValues"
        For x = 2 To 5
            Debug.Print getSingleQuotedValues(.Cells(x, 1).EntireRow.Range("A1:BD1"))
        Next

        Debug.Print vbCrLf & "Test getAccessValues"
        For x = 2 To 5
            Debug.Print getAccessValues(.Cells(x, 1).EntireRow.Range("A1:BD1"))
        Next

        Debug.Print vbCrLf & "Test getMySQLValues"
        For x = 2 To 5
            Debug.Print getMySQLValues(.Cells(x, 1).EntireRow.Range("A1:BD1"))
        Next

    End With
End Sub