Question

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

我正在数据库之间传输数据。在旧的项目中，每个项目的所有值都单独存储。在新数据库中，我想利用以下事实：大量的项目通过将这些值集存储为配置来共享相同的值。我正在vba中为excel执行此操作。

要确定什么是唯一的值集，我想使用以键为集合的字典。它让我这样做使我陷入了一种虚假的安全感，但是它无法识别出密钥在哪里相同。

示例代码如下。应该只在字典中添加两项，但将全部添加三项。我是否缺少某些内容或只是期望字典太多？如果我不需要手动比较所有设置，将为我节省一些时间。

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

如评论中所述，即使两个对象（例如，两个Collection或两个Ranges）具有相同的值，它们也不相同，并且您的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

Microsoft脚本运行时词典，使用集合作为键

1 个答案: