有没有更快的方法来比较VBA中动态数组之间的数据？

Question

我有以下代码成功运行,但它必须在两个130k +行的数组上运行.完整数据集上的当前运行时间大约为24分钟,并且在一个点上添加了计数,它循环了98亿次.

我已阅读有关使用Match,Vlookup的文章,他们似乎都建议迭代循环(我已经使用过)是最快的方法,但是我无法理解如何让其他方法使用动态数组和因此适当地测试.

是否有人能够告诉我是否有更快的方法来完成此活动,如果有,请演示如何？

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

我同意 Scripting.Dictionary 方法。

\n\n

\n

此过程使用 Scripting.Dictionsry。您需要进入 VBE 的工具 \xe2\x96\xba 引用并添加对 Microsoft 脚本运行时的引用。

\n

\n\n

Sub TESTVLOOKUPARRAY()\n    Dim PSORG1 As Variant, PSORG2 As Variant\n    Dim a As Long, b As Long\n    Dim dPSORG2 As New Scripting.dictionary\n\n    dPSORG2.CompareMode = TextCompare\n\n    Debug.Print Timer\n\n    With Sheets("Sheet1")\n        a = .Cells(Rows.Count, 1).End(xlUp).Row\n        PSORG2 = .Cells(1, 1).Resize(a, 2).Value2 \' PSORG2 is now an allocated array\n        For b = LBound(PSORG2, 1) To UBound(PSORG2, 1)\n            dPSORG2.Item(PSORG2(b, 1)) = PSORG2(b, 2)\n        Next b\n    End With\n\n    With Sheets("Sheet2")\n        a = .Cells(Rows.Count, 1).End(xlUp).Row\n        PSORG1 = .Cells(1, 1).Resize(a, 2).Value2 \' PSORG1 is now an allocated array\n    End With\n\n    Debug.Print dPSORG2.Count\n    Debug.Print LBound(PSORG2, 1) & ":" & UBound(PSORG2, 1)\n    Debug.Print LBound(PSORG2, 2) & ":" & UBound(PSORG2, 2)\n    Debug.Print LBound(PSORG1, 1) & ":" & UBound(PSORG1, 1)\n    Debug.Print LBound(PSORG1, 2) & ":" & UBound(PSORG1, 2)\n\n    For b = LBound(PSORG1, 1) To UBound(PSORG1, 1)\n        If dPSORG2.Exists(PSORG1(b, 1)) Then\n            PSORG1(b, 2) = dPSORG2.Item(PSORG1(b, 1))\n        Else\n            PSORG1(b, 2) = "NULL"\n        End If\n    Next b\n\n\n    With Sheets("Sheet2")\n        .Cells(1, 1).Resize(UBound(PSORG1, 1), UBound(PSORG1, 2)) = PSORG1\n    End With\n\n    Debug.Print Timer\n\nEnd Sub\n

\n\n

\n

FWIW，我的 Sheet1 上 110K 行和 Sheet2 中 95K 行的示例数据使用您的原始代码运行了 20 分钟 40 秒。上述相同数据花费了 1.72 秒。

\n

\n