Question

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

使用工作表SSB中的A列加载SSBarray。
使用工作表EDM中的第I列加载EDMarray。
比较上述数组并根据可能的匹配排序为两个新数组IDarray和noIDarray。
将新阵列输出到各自的工作表中。

步骤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方法，它比使用比较每个值的简单迭代使用更快的哈希查找。

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

使用词典的示例（您需要添加对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

请注意，这假设您的键列具有唯一值。如果他们不，您可以在添加值之前测试密钥的存在（这与您的代码只进行第一次匹配的行为相匹配），或者您可以创建{{1}每个键存储在Collection中的值，或完全取决于您的要求的其他内容。

构建和比较数组

1 个答案: