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

我有两个2D数组（我们称它们为A和B），都包含元素0处的序列号和元素1处的日期。A中的许多序列号在B中找到（约60%）。如果存在匹配项，我需要检查数组B中的对应日期是否小于数组a中的日期，如果是，则将数组a中的日期设置为null

目前我正在使用循环中的循环：

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

这需要两倍的时间，您需要处理未找到的错误

我尝试过创建两个一维数组（序列、日期），而不是2D数组，并使用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

---

根据需要调整工作表和范围。虽然计时结果非常主观，但这需要~1/₃ 在Sheet1和Sheet2中的30K行随机数据中排名第二。

速度很慢，因为您每次都在遍历所有内容。如果有，您是如何填充he数组的？通常，从工作表中获取hte.Value2创建一个基于一而不是基于零的二维数组。我不知道VBA有一个字典类，谢谢！这应该能很好地解决问题，我今天下午晚些时候再做。关于填充-数组是基于零的，我在不同的工作表上以循环的形式将它们输入数组。哈，你甚至还帮我保存了编码，太棒了！非常感谢。如果其他人正在寻找此解决方案，但错过了我们之前的评论，我不知道VBA中有词典，这是一个完美的解决方案。需要注意的一个重要事项是我从arrB填充词典的方式。这是“覆盖”方法。如果序列号重复，则最后一次出现（及其日期）是保留的序列号。如果未对日期进行排序，并且第二次出现的日期可能早于第一次出现的日期，则在加载之前应检查

是否存在dictB.

，如果以前存在，则只应保留最新的日期。无重复项，但感谢提示，我会记得在添加之前检查字典，看这是否是将来的风险

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