build立和比较数组

我有下面的代码，我试图去工作。 这是我第一次处理VBA中的数组。 这里是我要去的纯英文版本：

1. 从工作表SSB的列A加载SSBarray。
2. 从工作表EDM加载列I的EDMarray。
3. 比较上面的数组，并根据可能的匹配将它们sorting成两个新数组IDarray和noIDarray。
4. 将新arrays输出到它们各自的工作表中。

第四步是暂时的，以确保代码是正常工作。 整个项目将所有的数据从3张汇编到这两个列表中。 工作表1只有数据点A，工作表2可能有也可能没有数据点A，B和/或C，而工作表3可能有也可能没有数据点A，B和/或C.我的代码是我开始检查工作表1中的所有数据点A在工作表2中。运行时间也是一个因素。 我会采取任何和所有的帮助，我可以在这一点上得到。 谢谢。

'Build Arrays Dim i As Long, j As Long Dim SSBarray Dim EDMarray Dim IDarray Dim noIDarray Dim YCounter As Long Dim NCounter As Long Dim inArray As Boolean endSSB = SSB.Range("A" & Rows.Count).End(xlUp).Row endEDM = EDM.Range("A" & Rows.Count).End(xlUp).Row BBlast = BB.Range("A" & BB.Range("A" & Rows.Count).End(xlUp).Row) ReDim SSBarray(1 To endSSB) ReDim EDMarray(1 To endEDM) For i = 2 To endSSB SSBarray(i) = SSB.Cells(i, 1).Value2 Next i For i = 2 To endEDM EDMarray = EDM.Cells(i, 9).Value2 Next i For i = 2 To endSSB inArray = False For j = 2 To endEDM If SSBarray(i) = EDMarray(j) Then inArray = True YCounter = YCounter + 1 ReDim Preserve IDarray(1 To YCounter) IDarray(YCounter) = SSBarray(i) Exit For End If Next j If inArray = False Then NCounter = NCounter + 1 ReDim Preserve noIDarray(1 To NCounter) noIDarray(NCounter) = SSBarray(i) End If Next i For i = 1 To UBound(IDarray) Identifiers.Cells(i, 4) = IDarray(i) Next i For i = 1 To UBound(noIDarray) NoIdentifiers.Cells(i, 4) = noIDarray(i) Next i End Sub 

修订代码：

 'Sort and Compile Data Dim i As Long endSSB = SSB.Range("A" & Rows.Count).End(xlUp).Row endEDM = EDM.Range("A" & Rows.Count).End(xlUp).Row BBlast = BB.Range("A" & BB.Range("A" & Rows.Count).End(xlUp).Row) Public Type otherIDs SEDOL As Variant ISIN As Variant End Type Dim SSBIds As New Scripting.Dictionary Dim IDs As otherIDs For i = 2 To endSSB 'Add an ID\row number pair SSBIds.Add SSB.Cells(i, 1).Value2 Next i Dim EDMIds As New Scripting.Dictionary For i = 2 To endEDM IDs.SEDOL = EDM.Cells(i, 8).Value2 IDs.ISIN = EDM.Cells(i, 7).Value2 EDMIds.Add EDM.Cells(i, 9).Value2, IDs.SEDOL, IDs.ISIN Next i Dim IdMatches As New Scripting.Dictionary Dim IdMisMatches As New Scripting.Dictionary Dim key As Variant For Each key In SSBIds 'If it's in the other dictionary... If EDMIds.Exists(key) Then '...add the row to the matches... IdMatches.Add key, EDMIds(key) Else '...otherwise add the row to the mismatches. IdMisMatches.Add key, EDMIds(key) End If Next i = 1 For Each key In IdMatches.Keys Identifiers.Cells(i, 4) = key Identifiers.Cells(i, 5) = IdMatches.IDs.SEDOL Identifier.Cells(i, 6) = IdMatches.IDs.ISIN i = i + 1 Next i = 1 For Each key In IdMisMatches.Keys NoIdentifiers.Cells(i, 4) = key i = i + 1 Next 

Answer 1

数组不是在这里使用的最好的容器。 字典有一个.Exists方法，比简单的迭代比较每个值使用更快的哈希查找。

不仅如此，多次调用Redim Preserve与向Dictionary添加项目相比效率非常低。 每次增加数组维度时， 整个数据集被复制到新分配的内存区域，数组的数据指针被更新指向它。

使用字典的示例（您需要添加对Microsoft脚本运行时的引用）：

 Dim SSBIds As New Scripting.Dictionary For i = 2 To endSSB 'Add an ID\row number pair SSBIds.Add SSB.Cells(i, 1).Value2, i Next i Dim EDMIds As New Scripting.Dictionary For i = 2 To endEDM EDMIds.Add EDM.Cells(i, 9).Value2, i Next i Dim IdMatches As New Scripting.Dictionary Dim IdMisMatches As New Scripting.Dictionary Dim key As Variant For Each key In SSBIds 'If it's in the other dictionary... If EDMIds.Exists(key) Then '...add the row to the matches... IdMatches.Add key, EDMIds(key) Else '...otherwise add the row to the mismatches. IdMisMatches.Add key, EDMIds(key) End If Next i = 1 For Each key In IdMatches.Keys Identifiers.Cells(i, 4) = key i = i + 1 Next i = 1 For Each key In IdMisMatches.Keys NoIdentifiers.Cells(i, 4) = key i = i + 1 Next 

请注意，这假定您的关键列具有唯一的值。 如果他们不这样做 ，那么可以在添加一个值之前testing密钥的存在（这与您的代码的行为仅匹配第一个匹配项），或者您可以创build一个值Collection来存储Dictionary中的每个密钥，或完全取决于您的要求的其他东西。