arrays - 构建和比较数组

Question

我有以下代码，我正在尝试开始工作。这是我第一次在 VBA 中处理数组。这是我想要的简单英文版本:

1. 从工作表 SSB 中加载 A 列的 SSBarray。
2. 从工作表 EDM 中加载包含 I 列的 EDMarray。
3. 比较上述数组，并根据可能的匹配将其排序为两个新数组 IDarray 和 noIDarray。
4. 将新数组输出到各自的工作表中。

第 4 步是临时的，只是为了确保代码正常工作。整个项目将 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 方法，它使用比比较每个值的简单迭代更快的哈希查找。

不仅如此，与向 Dictionary 添加项目相比，重复调用 Redim Preserve 的效率极其低下。每次增加数组维度时，整个数据集都会被复制到新分配的内存区域，并且数组的数据指针也会更新以指向它。

使用字典的示例(您需要添加对 Microsoft Scripting Runtime 的引用):

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

请注意，这假设您的键列具有唯一值。如果不，您可以在添加值之前测试键是否存在(这符合您的代码仅获取第一个匹配项的行为)，或者您可以创建一个集合 要存储在每个键的 Dictionary 中的值，或者完全取决于您的要求的其他内容。