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

我有两个二维数组（我们称之为A和B），它们都包含元素0处的序列号和元素1处的date.A中的许多序列号都在B中find（大约60％）。 如果有匹配，我需要检查数组B中的相应date是否小于数组A中的date，如果是，则将A中的date设置为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秒），所以我一直在试图devise其他方法，其中一些非常古怪，如

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

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

我已经尝试创build两个一维数组（连续，date），而不是二维数组B，并使用application.match提供一个date索引，但这又需要大约两倍的时间才能完成。 最后，我试图将数据写入工作表，通过vlookup获取date并比较它们，但这不是更快，也不是我想要的。

任何想法赞赏。

Answer 1

这里是一些基于序列号比较date的框架。

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