使用 Excel 宏 VBA 在 excel 范围内查找行的最快方法

Muh*_*man 1 excel vba

我有一个 excel 电子表格(sheet2),里面有大约 100 万的计数记录。我正在迭代这些记录,对于每次迭代,我将一行选定的列与 sheet1 中大约 2000 条记录的另一个范围进行比较。

rangeA = 1 Million rows 'Sheet2
rangeB = 2000 rows 'Sheet1

With sheet1
For Each row In rangeA.Columns.Rows

   For Each rangeBRow In rangeB.Columns.Rows
     If (.Cells(rangeBRow.Row,1).Value = CName And .Cells(rangeBRow.Row,2).Value = LBL ... ) Then
     ' Do something cool... set some cell value in sheet2
     Exit For
     End If
   Next rangeBRow

Next row
End With
Run Code Online (Sandbox Code Playgroud)

我对上述代码的问题是完成执行需要很长时间。除了为 2000 行迭代 100 万条记录之外,是否还有其他最快和快速的方法来针对 excel 宏中的一系列行查找行?

感谢您的时间。

Tim*_*ams 5

12 秒检查 5k 行和 200k 行:

Sub Compare()

    Dim rngA As Range, rngB As Range
    Dim dict As Object, rw As Range
    Dim a As Application, tmp As String

    Set a = Application
    Set dict = CreateObject("scripting.dictionary")

    Set rngA = Sheet1.Range("A2:F200000")
    Set rngB = Sheet1.Range("K2:P5000")

    For Each rw In rngA.Rows
        'Create a key from the entire row and map to row
        ' If your rows are not unique you'll have to do a bit more work here
        ' and use an array for the key value(s)
        dict.Add Join(a.Transpose(a.Transpose(rw.Value)), Chr(0)), rw.Row
    Next rw

    For Each rw In rngB.Rows
        'does this row match one in range A?
        tmp = Join(a.Transpose(a.Transpose(rw.Value)), Chr(0))
        If dict.exists(tmp) Then
            rw.Cells(1).Offset(0, -1).Value = dict(tmp)
        End If
    Next rw

End Sub
Run Code Online (Sandbox Code Playgroud)