VBA如何循环单元格

如何解决VBA如何循环单元格

我有以下脚本，它假设从我的 excel 文档中获取数据并将数据上传到共享点列表中。

Sub AddItem()
'
' Requires a reference to "Microsoft ActiveX Data Object 6.0 Libray" to insert a record into a sharepoint list "AccessLog"
'
    Dim cnt As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim MysqL As String

    Set cnt = New ADODB.Connection
    Set rst = New ADODB.Recordset

    MysqL = "SELECT * FROM [Test];"

    With cnt ' See https://www.connectionstrings.com/sharepoint/

.ConnectionString = _
        "Provider=Microsoft.ACE.OLEDB.12.0;WSS;IMEX=0;RetrieveIds=Yes;DATABASE=https://share.amazon.com/sites/IPV;List={2B0ED605-AE50-4D39-A46E-77CC15D6F17E};"
        .Open
    End With

    rst.Open MysqL,cnt,adOpenDynamic,adLockOptimistic

    rst.AddNew
        rst.Fields("Title") = Sheets("Sheet1").Range("C3").Value
        rst.Fields("Names") = Sheets("Sheet1").Range("D3").Value
    rst.Update ' commit changes to SP list

    If CBool(rst.State And adStateOpen) = True Then rst.Close
    If CBool(cnt.State And adStateOpen) = True Then cnt.Close
End Sub

脚本按预期工作，但唯一的“问题”是使用这种方法，我只能为每个字段类型输入一个元素。 我想知道是否有办法循环遍历所有列，例如， rst.Fields("Title") = Sheets("Sheet1").Range("C3").Value 然后 C4,C5 直到最后一行。

我会有这样的excel表格：

解决方法

使用 Cells(row,col) 来访问单元格值而不是命名范围。

for row = 1 to max_row
    recordset.addnew
    for col = 1 to max_col
        recordset.fields(col).value = worksheet.cells(row,col).value
    next col
    recordset.update
next row

,

希望能帮到你

Sub MySub()

    'In CurrRow you will save the row,before move between columns
    Dim CurrRow As Double
    Range("A1").Select ' Choice where it will start    first row and column
   
    Do While ActiveCell <> "" 'loop row
    
        CurrRow = ActiveCell.Row ' save current row
    
        Do While ActiveCell <> "" 'loop column
       
            '----
        
        
            'Your code operations or anything you need to do with each cell
        
        
            '----
             ActiveCell.Offset(0,1).Select ' next column
        Loop
        Range("A" & CurrRow).Select '<--Change A if need,equal as the first column
        ActiveCell.Offset(1,0).Select ' next row
    Loop

End Sub