excel - 加快在 Excel 中循环遍历大型数据集

Question

我有两个数据集需要比较并从中提取匹配项。我有一个来自每个数据集中 5 列的复合键，结束我需要提取的第 6 列。列由文本、日期和整数组成。两组都略低于 50 万行。

目前我在表a中使用for循环并循环遍历表b。将行与带有 and 参数的 if 语句进行比较以获取复合键。

Sub ArraySearch()

    Dim Main As Long
    Dim Search As Long
    Dim arrData() As Variant
    Dim arrSource As Variant

    arrData = Sheets("Sheet1").Range("H3:M500000").Value
    arrSource = Sheets("Ark1").Range("A3:H500000").Value

    Main = 1
    Search = 1

    For Main = 1 To UBound(arrSource, 1)

        For Search = 1 To UBound(arrData, 1)

            If arrSource(Main, 3) = arrData(Search, 1) And _
                arrSource(Main, 4) = arrData(Search, 2) And _
                arrSource(Main, 1) = arrData(Search, 3) And _
                arrSource(Main, 2) = arrData(Search, 4) And _
                arrSource(Main, 5) = arrData(Search, 5) _
            Then
                arrSource(Main, 8) = arrData(Search, 6)
                Exit For
            End If

        Next
    Next

    Sheets("Sheet2").Range("A3:H500000") = arrSource

End Sub

目前最快的方法是将两个表加载到一个数组中并执行内存循环。

这是永远的。我们谈论的是小时而不是分钟。

有什么方法可以提高速度吗？或者我需要使用其他一些程序吗？(将其加载到数据库中并使用 SQL，使用带有普通 VB.net、SSIS 的 visual studio)

我希望这可以在 VBA 中完成，因此非常感谢任何指点。

编辑

散列 5 列键会提高速度，还是必须迭代的行的共享量会造成延迟？

Answer 1

比较两个列表的最快方法是根据公共(public)键将值添加到字典中。字典经过优化以搜索键，并且将根据键更快地返回值，然后您可以遍历数组。

Sub DictionarySearch()
    Dim dict
    Dim key As String
    Dim x As Long
    Dim arrData() As Variant
    Dim arrSource As Variant

    Set dict = CreateObject("Scripting.Dictionary")

    arrData = Worksheets("Sheet1").Range("H3:M500000").Value
    arrSource = Worksheets("Ark1").Range("A3:H500000").Value

    For x = 1 To UBound(arrData, 1)
        key = arrData(x, 1) & ":" & arrData(x, 2) & ":" & arrData(x, 3) & ":" & arrData(x, 4) & ":" & arrData(x, 5)
        If Not dict.Exists(key) Then dict.Add key, arrData(x, 6)

    Next

    For x = 1 To UBound(arrSource, 1)
        key = arrSource(x, 3) & ":" & arrSource(x, 4) & ":" & arrSource(x, 1) & ":" & arrSource(x, 2) & ":" & arrSource(x, 5)
        If dict.Exists(key) Then arrSource(x, 8) = dict(key)
    Next

    Sheets("Sheet2").Range("A3:H500000") = arrSource
End Sub