Excel VBA 比较两个二维数组的有效方法

Excel VBA efficient way to compare two 2D arrays

我有两个二维数组(我们称它们为 A 和 B),都在元素 0 处包含序列号,在元素 1 处包含日期。A 中的许多序列号都可以在 B 中找到(大约 60%)。如果匹配,我需要检查数组 B 中的相应日期是否小于数组 A 中的日期,如果是,则将 A 中的日期设置为空。

目前我正在循环中使用循环:

For x = 0 To UBound(arrayA)

    For y = 0 To UBound(arrayB)

        If arrayB(y, 0) = arrayA(x, 0) Then ' the serial numbers match

            If arrayB(y, 1) < arrayA(x, 1) Then ' test the dates

                arrayA(x, 1) = Null

            End If

            Exit For

        End If

    Next y

Next x

这很好但很慢(大约 30 - 40 秒)所以我一直在尝试设计其他方法,其中一些非常古怪,例如

dateB = application.Vlookup(arrayB, arrayA(x), 1, false

这需要两倍的时间,您需要处理未发现的错误。

我已经尝试创建两个一维数组(序列号、日期)而不是二维数组 B 并使用 application.match 提供日期索引,但这同样需要大约两倍的时间才能完成。最后,我尝试将数据写入工作表,通过 vlookup 获取日期并比较它们,但这并没有更快,也不是我真正想要的。

任何想法表示赞赏。

这是一些基于序列号比较日期的框架。

Sub dictCompare()
    Dim a As Long, arrA As Variant, arrB As Variant, dictB As Object
    Debug.Print Timer

    Set dictB = CreateObject("scripting.Dictionary")
    dictB.comparemode = vbTextCompare

    With Worksheets("sheet1")
        With Intersect(.UsedRange, .Range("A:B"))
            arrA = .Cells.Value2
        End With
    End With

    With Worksheets("sheet2")
        With Intersect(.UsedRange, .Range("A:B"))
            arrB = .Cells.Value2
        End With
        For a = LBound(arrB, 1) + 1 To UBound(arrB, 1) 'LBound(arrB, 1)+1 to skip the column header label
            dictB.Item(arrB(a, 1)) = arrB(a, 2)
        Next a
    End With

    For a = LBound(arrA, 1) + 1 To UBound(arrA, 1) 'LBound(arrA, 1)+1 to skip the column header label
        If dictB.exists(arrA(a, 1)) Then
            If dictB.Item(arrA(a, 1)) > arrA(a, 2) Then _
                arrA(a, 2) = vbNullString
        End If
    Next a

    With Worksheets("sheet1")
        .Cells(1, 1).Resize(UBound(arrA, 1), UBound(arrA, 2)) = arrA
    End With
    Debug.Print Timer
End Sub

适当调整工作表和范围。虽然计时结果非常主观,但对于 Sheet1 和 Sheet2 中的 30K 行随机数据,这需要大约 1⁄3 秒。