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

时间:2014-03-27 11:01:59

标签: excel vba excel-vba

我有一张excel电子表格(sheet2),其记录数约为1百万。我正在迭代这些记录,并且对于每次迭代,我将一行选定列与另一个大约2000条记录的范围进行比较,这些记录位于sheet1中。

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

我对上述代码的问题是它需要永远完成执行。除了为2000行迭代一百万条记录之外,还有其他一些快速且快速的方法可以在excel宏中查找一行行吗?

感谢您的时间。

1 个答案:

答案 0 :(得分:2)

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