Question

我有两个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

这样可以正常但很慢（大约30 - 40秒）所以我一直试图设计其他方法，其中一些非常古怪，如

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

需要两倍的时间，你需要处理未找到的错误。

我尝试创建两个一维数组（连续出版物，日期）而不是2D arrayB，并使用application.match为日期提供索引，但这又需要两倍的时间才能完成。最后，我尝试将数据写入工作表，通过vlookup＆amp;获取日期。比较它们但这并不快并不是我想要的。

任何想法都赞赏。

Answer 1

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

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秒。

Excel VBA有效比较两个2D数组的方法

1 个答案: