Gibt es eine schnellere Möglichkeit, Daten zwischen dynamischen Arrays in VBA zu vergleichen?

Question

Ich habe den folgenden Code erfolgreich funktioniert, jedoch muss es auf zwei Arrays von jeweils 130k + Zeilen ausgeführt werden. Die aktuelle Laufzeit für den gesamten Datensatz beträgt etwa 24 Minuten. Nach einer Zählung von einem Punkt werden 9,8 Milliarden Male wiederholt. Ich habe Artikel über die Verwendung von Match, Vlookup gelesen und sie scheinen alle darauf hinzuweisen, dass eine iterative Schleife (wie ich sie benutzt habe) die schnellste Methode ist, aber ich konnte nicht verstehen, wie man die anderen Methoden zum Laufen bringt mit dynamischen Arrays und damit entsprechend testen.

Kann mir jemand sagen, ob es einen schnelleren Weg gibt, diese Aktivität abzuschließen, und wenn ja, wie?

Sub TESTVLOOKUPARRAY() 
    Dim PSORG1() As Variant 
    Dim PSORG1Tot As Variant 
    Dim PSORG1RT As Variant 
    Dim PSORG2() As Variant 
    Dim PSORG2Tot As Variant 
    Dim PSORG2RT As Variant 

    Sheets("Sheet1").Select 
    PSORG2RT = Application.CountA(Range("A:A")) 
    PSORG2Tot = "A1:B" & PSORG2RT 
    PSORG2 = Range(PSORG2Tot) ' PSORG2 is now an allocated array 

    Sheets("Sheet2").Select 
    PSORG1RT = Application.CountA(Range("A:A")) 
    PSORG1Tot = "A1:B" & PSORG1RT 
    PSORG1 = Range(PSORG1Tot) ' PSORG1 is now an allocated array 

    a = 2 ' to increment ORG values in PSORG1 

    Do 
     Finish = "No" 
     b = 1 ' to increment ORG values in PSORG2 
     Do 
      If PSORG1(a, 1) = PSORG2(b, 1) Then 
       PSORG1(a, 2) = PSORG2(b, 2) 
       Finish = "True" 
      ElseIf b = PSORG2RT Then 
       PSORG1(a, 2) = "NULL" 
       Finish = "True" 
      End If 
      b = b + 1 
     Loop Until Finish = "True" 
     a = a + 1 
    Loop Until a = PSORG1RT + 1 

    Sheets("Sheet2").Select 
    Set Destination = Range("A1") 
    Destination.Resize(UBound(PSORG1, 1), UBound(PSORG1, 2)).Value = PSORG1 

End Sub 

Answer 1

Ich stimme der Scripting.Dictionary-Methode zu.

Diese Prozedur verwendet eine Scripting.DictionSry. Sie müssen in die VBE-Tools ► Verweise gehen und einen Verweis auf die Microsoft Scripting Runtime hinzufügen.

Sub TESTVLOOKUPARRAY() 
    Dim PSORG1 As Variant, PSORG2 As Variant 
    Dim a As Long, b As Long 
    Dim dPSORG2 As New Scripting.dictionary 

    dPSORG2.CompareMode = TextCompare 

    Debug.Print Timer 

    With Sheets("Sheet1") 
     a = .Cells(Rows.Count, 1).End(xlUp).Row 
     PSORG2 = .Cells(1, 1).Resize(a, 2).Value2 ' PSORG2 is now an allocated array 
     For b = LBound(PSORG2, 1) To UBound(PSORG2, 1) 
      dPSORG2.Item(PSORG2(b, 1)) = PSORG2(b, 2) 
     Next b 
    End With 

    With Sheets("Sheet2") 
     a = .Cells(Rows.Count, 1).End(xlUp).Row 
     PSORG1 = .Cells(1, 1).Resize(a, 2).Value2 ' PSORG1 is now an allocated array 
    End With 

    Debug.Print dPSORG2.Count 
    Debug.Print LBound(PSORG2, 1) & ":" & UBound(PSORG2, 1) 
    Debug.Print LBound(PSORG2, 2) & ":" & UBound(PSORG2, 2) 
    Debug.Print LBound(PSORG1, 1) & ":" & UBound(PSORG1, 1) 
    Debug.Print LBound(PSORG1, 2) & ":" & UBound(PSORG1, 2) 

    For b = LBound(PSORG1, 1) To UBound(PSORG1, 1) 
     If dPSORG2.Exists(PSORG1(b, 1)) Then 
      PSORG1(b, 2) = dPSORG2.Item(PSORG1(b, 1)) 
     Else 
      PSORG1(b, 2) = "NULL" 
     End If 
    Next b 


    With Sheets("Sheet2") 
     .Cells(1, 1).Resize(UBound(PSORG1, 1), UBound(PSORG1, 2)) = PSORG1 
    End With 

    Debug.Print Timer 

End Sub 

FWIW, meine Beispieldaten von 110K Reihen auf Sheet1 und 95K Reihen in Sheet2 liefen in 20 Minuten, 40 Sekunden mit Ihrem ursprünglichen Code. Das obige dauerte 1,72 Sekunden mit den gleichen Daten.

Answer 2

Ich denke, mit Dictionaries würde der Code schneller machen.

Unten ist der Code, der die gleiche Aufgabe ausführt, aber er verwendet Dictionary-Objekt. Auf meinem Computer ist es etwa 100x schneller als Ihr eigener Code (getestet auf zwei Arbeitsblättern mit jeweils 5K Zeilen, für größere Datensätze sollte die Verstärkung noch besser sein).

Public Function TestVLookupArray2() 
    Dim dict As Object 
    Dim result As Variant 
    Dim i As Long 
    Dim destination As Excel.Range 


    'Load values from Sheet1 into Dictionary. 
    Set dict = getDataFromSheetAsDictionary(Sheets("Sheet1")) 

    result = getDataFromSheet(Sheets("Sheet2")) 

    For i = LBound(result, 1) To UBound(result, 1) 

     With dict 
      If .exists(result(i, 1)) Then 
       result(i, 2) = .Item(result(i, 1)) 
      Else 
       result(i, 2) = "NULL" 
      End If 
     End With 

    Next i 

    With Sheets("Sheet2") 
     Set destination = .Range(.Cells(1, 1), .Cells(UBound(result, 1), UBound(result, 2))) 
     destination = result 
    End With 

End Function 


Private Function getDataFromSheet(wks As Excel.Worksheet) As Variant 
    Dim lastRow As Long 

    With wks 
     lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row 
     getDataFromSheet = .Range(.Cells(1, 1), .Cells(lastRow, 2)) 
    End With 

End Function 


Private Function getDataFromSheetAsDictionary(wks As Excel.Worksheet) As Object 
    Dim i As Long 
    Dim key As String 
    Dim value As Variant 
    Dim arr As Variant 

    Set getDataFromSheetAsDictionary = VBA.CreateObject("Scripting.Dictionary") 

    arr = getDataFromSheet(wks) 

    With getDataFromSheetAsDictionary 
     For i = LBound(arr, 1) To UBound(arr, 1) 

      If Not .exists(arr(i, 1)) Then 
       Call .Add(arr(i, 1), arr(i, 2)) 
      End If 

     Next i 
    End With 

End Function 

Beachten Sie, dass dieser Code aus 3 separaten Funktionen besteht, die Sie alle einschließen müssen.

Hier ist der Artikel Wörterbücher Einführung: http://www.techbookreport.com/tutorials/vba_dictionary.html

Wenn Sie Fragen zu diesem Code haben, lassen Sie mich in den Kommentaren wissen.

Answer 3

Ich habe eine for next Schleife verwendet, als eine Pose zu der do Schleife von Ihnen verwendet.

Sub speed_up2() 
    Dim PSORG1() As Variant, PSORG2() As Variant 
    Dim PSORG1Tot As Range, PSORG2Tot As Range, Destination As Range 
    Dim PSORG1RT As Long, PSORG2RT As Long 
    Dim wb As Workbook, ws_1 As Worksheet, ws_2 As Worksheet 
    Dim i As Byte, j As Byte 

    Set wb = ThisWorkbook 
    Set ws_1 = wb.Sheets("Sheet1") 
    Set ws_2 = wb.Sheets("Sheet2") 

    with ws_1 
     PSORG2RT = .Cells(Rows.Count, 1).End(xlUp).Row ' Get last row 
     Set PSORG2Tot = .Range("A1:B" & PSORG2RT) 
     PSORG2 = PSORG2Tot ' PSORG2 is now an allocated array 
    End With 

    With ws_2 
     PSORG1RT = .Cells(Rows.Count, 1).End(xlUp).Row 
     Set PSORG1Tot = .Range("A1:B" & PSORG1RT) 
     PSORG1 = PSORG1Tot ' PSORG1 is now an allocated array 
    End With 

    For i = 1 To UBound(PSORG1) 
     For j = 1 To UBound(PSORG2) 
      PSORG1(i, 2) = "NULL" 
      If PSORG1(i, 1) = PSORG2(j, 1) Then 
       PSORG1(i, 2) = PSORG2(j, 2) 
       Exit For 
      End If 
     Next j 
    Next i 

    Set Destination = ws_2.Range("A1") 
    Destination.Resize(UBound(PSORG1, 1), UBound(PSORG1, 2)).Value = PSORG1 
End Sub 

Bitte sehen here für einen Speedtest, der zwischen der for next Schleife und der do Schleife durchgeführt wurde.

Wie im Artikel angegeben, führt die Schleife for next die Berechnung der nächsten Iteration für Sie durch, während Sie mit der Schleife do die Iteration jedes Mal selbst inkrementieren müssen. Dies kann viel Zeit sparen.

Ich habe auch die Methode geändert, um die letzte Zeile zu bekommen, die verwendet wird, um den Bereich zu erstellen. Das ist meine persönliche Vorliebe; es kann auch sicherer sein als Application.COUNTA zu verwenden.