从另一个数据集（VBA）中查找值的最快方法（代码加速）
我有两个数据集都在一个工作表内，称之为数据和IBES。 代码检查每个数据集中的6个variables是否相同，然后将特定列中的值写入另一个数据集。 为了find这个值，代码运行了288503行，速度非常慢。
我的问题是，如何加快这个代码？
非常感谢你！
Public Function GetRightValue() Dim i As Integer Dim j As Long Application.Calculation = xlCalculationManual Application.ScreenUpdating = False Application.DisplayStatusBar = False Application.EnableEvents = False ActiveSheet.DisplayPageBreaks = False For i = 2 To 1511 'Loop over all values from total dataset For j = 2 To 288503 'Loop over all values from IBES file If Worksheets("Data").Cells(i, 3) = Worksheets("IBES").Cells(j, 1) Then If Worksheets("Data").Cells(i, 7) = Worksheets("IBES").Cells(j, 6) Then If Worksheets("Data").Cells(i, 10) = Worksheets("IBES").Cells(j, 9) Then If Worksheets("Data").Cells(i, 13) = Worksheets("IBES").Cells(j, 11) Then If Worksheets("Data").Cells(i, 8) = Worksheets("IBES").Cells(j, 7) Then If Worksheets("Data").Cells(i, 14).Text = Worksheets("IBES").Cells(j, 13).Text Then Worksheets("Data").Cells(i, 12) = Worksheets("IBES").Cells(j, 10).Text Worksheets("Data").Cells(i, 18) = Worksheets("IBES").Cells(j, 16).Text End If End If End If End If End If End If Next j Next i Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Application.DisplayStatusBar = True Application.EnableEvents = True ActiveSheet.DisplayPageBreaks = True End Function 你可以用字典。 将Microsoft Scripting Runtime的引用添加到您的项目（VBA编辑器中的“ Tools/References ”），然后尝试：
Public Function GetRightValue() Dim i As Long Dim j As Long Dim d As New Dictionary, k As String, c As Collection, v As Variant Application.Calculation = xlCalculationManual Application.ScreenUpdating = False Application.DisplayStatusBar = False Application.EnableEvents = False ActiveSheet.DisplayPageBreaks = False With Worksheets("Data") For i = 1 To 1511 k = Join(Array(.Cells(i, 3).Value, .Cells(i, 7).Value, _ .Cells(i, 10).Value, .Cells(i, 13).Value, .Cells(i, 8).Value, _ .Cells(i, 14).Value, .Cells(i, 12).Value, .Cells(i, 18).Value), "#") If Not d.Exists(k) Then Set c = New Collection d.Add k, c End If d.Item(k).Add i Next i End With With Worksheets("IBES") For j = 2 To 288503 k = Join(Array(.Cells(j, 1).Value, .Cells(j, 6).Value, _ .Cells(j, 9).Value, .Cells(j, 11).Value, .Cells(j, 7).Value, _ .Cells(j, 13).Value, .Cells(j, 10).Value, .Cells(i, 16).Value), "#") If d.Exists(k) Then For Each v In d.Item(k) Worksheets("Data").Cells(v, 12) = .Cells(j, 10) Worksheets("Data").Cells(v, 18) = .Cells(j, 16) Next v End If Next j End With Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Application.DisplayStatusBar = True Application.EnableEvents = True ActiveSheet.DisplayPageBreaks = True End Function
1）设置你的工作表variables例如
Dim ws1, ws2 as Worksheet Set ws1 = Sheets("Data") Set ws2 = Sheets("IBES") If ws1.Cells(i, 3) = ws2.Cells(j, 1) Then... etc
2）用And语句排列所有那些If语句可能会更快
3）如果你的Ifs中的一个是假的，则转到下一个迭代。 这比现存的孩子Ifs节省了一点点
For x = 1 to 10 If myCondion then doStuff Else GoTo xLine End If xLine: Next x
4）有时可能会更快将数据集放入数组，然后比较数组项，例如
myArray = Range("A1:A10") myOtherArray = myOtherSheet.Range("A1:A10") If myArray(0,1) = myOtherArray(0 + whatever, 1) Then...
希望这可以帮助