Question

我有两个数据集都在工作表中，称之为数据和IBES。代码检查每个数据集中的6个变量是否相同，然后将值从特定列写入另一个数据集。要找到此值，代码将运行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

Answer 1

你可以使用字典。在项目中添加对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

Answer 2

1）将工作表设置为变量，例如

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 statements

在一行上排列所有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...

希望这有帮助

从另一个数据集（VBA）中查找值的最快方法（代码加速）

2 个答案: