使用集合作为键的 Microsoft 脚本运行时字典

Question

我有一系列数据，其中每个项目都有许多与之关联的值。项目块将共享这些值，然后对于其他项目，这些值会改变。

我正在数据库之间传输数据。在旧版本中，每个项目的所有值都单独存储。在新数据库中，我想通过将这些值集存储为配置来利用大量项目共享相同值的事实。我在 vba for excel 中这样做。

为了确定唯一的值集是什么，我想使用一个字典，其中键是一个集合。由于它允许我这样做，我陷入了一种错误的安全感，但是它无法识别密钥相同的位置。

示例代码如下。应该只在字典中添加两项，但添加所有 3。我是否遗漏了某些内容或只是对字典有太多期望？如果我不必手动比较所有集合，可以节省我一点时间。

Sub CollectionAsKeyTest()
Dim dic As New Dictionary
Dim col As Collection
Dim i As Integer

dic.CompareMode = BinaryCompare

'Create a collection to add to dictionary:
Set col = New Collection
For i = 1 To 10
    col.Add i * 1
Next i
dic.Add col, "item 1"

'Create a different collection and add as key to dictionary:
Set col = New Collection
For i = 1 To 10
    col.Add i * 2
Next i
If Not dic.Exists(col) Then dic.Add col, "item 2"

'Create a collection which is the same as the first, and try to add to dictionary:
Set col = New Collection
For i = 1 To 10
    col.Add i * 1
Next i
If Not dic.Exists(col) Then dic.Add col, "item 3"

'All three collections are added:
Debug.Print "Number of collections added = " & dic.count
End Sub

Answer 1

正如 cmets 中所讨论的，两个对象（例如两个集合或两个范围）并不相同，即使它们具有相同的值，您的 dic.Exists(col) 也将始终失败。

我建议将集合作为Value，并将一种散列写成key。如果集合不包含太多数据，只需连接集合的所有元素并将其作为键，但如果您希望它更复杂一点，您可以先计算一个真正的哈希。

下面的代码给你一个想法。哈希例程复制自https://en.wikibooks.org/wiki/Visual_Basic_for_Applications/String_Hashing_in_VBA

...
dim hash as string
hash = getHash(col)
If Not dic.Exists(hash) Then dic.Add hash, col
...

Function getHash(c As Collection)

    Dim s As String, i As Long
    For i = 1 To c.Count
        s = s & c(i) & "@@@"
    Next i
    ' Simple: 
    '   getHash = s
    ' Use a real hash:
    getHash = MD5(s)

End Function

Function MD5(ByVal sIn As String) As String

    Dim oT As Object, oMD5 As Object
    Dim TextToHash() As Byte
    Dim bytes() As Byte

    Set oT = CreateObject("System.Text.UTF8Encoding")
    Set oMD5 = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")

    TextToHash = oT.GetBytes_4(sIn)
    bytes = oMD5.ComputeHash_2((TextToHash))

    MD5 = ConvToHexString(bytes)

    Set oT = Nothing
    Set oMD5 = Nothing

End Function


Private Function ConvToHexString(vIn As Variant) As Variant

    Dim oD As Object

    Set oD = CreateObject("MSXML2.DOMDocument")

      With oD
        .LoadXML "<root />"
        .DocumentElement.DataType = "bin.Hex"
        .DocumentElement.nodeTypedValue = vIn
      End With
    ConvToHexString = Replace(oD.DocumentElement.Text, vbLf, "")

    Set oD = Nothing

End Function