Словарь сценариев выполнения Microsoft, использующий коллекцию в качестве ключа - PullRequest
Новая
       8

Словарь сценариев выполнения Microsoft, использующий коллекцию в качестве ключа

0 голосов
/ 20 марта 2019

У меня есть ряд данных, где каждый элемент имеет ряд значений, связанных с ним. Блоки элементов будут иметь эти значения, тогда как для других элементов они изменятся.

Я передаю данные между базами данных. В старом каждый элемент имеет все свои значения, хранящиеся отдельно. В новой базе данных я хочу воспользоваться тем фактом, что большое количество элементов имеют одинаковые значения, сохраняя эти наборы значений в качестве конфигурации. Я делаю это в VBA для 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

1 Ответ

3 голосов
/ 20 марта 2019

Как обсуждалось в комментариях, два объекта (например, две Коллекции или два Диапазона) не идентичны, даже если они имеют одинаковые значения, и ваш dic.Exists(col) всегда потерпит неудачу.

Iпредложил бы поместить коллекции как Значение и написать вид хэша как ключ .Если коллекции не содержат слишком много данных, просто объедините все элементы коллекции и укажите это как ключ, но если вы хотите, чтобы он был немного более сложным, вы можете сначала вычислить реальный хеш.

Следующий код дает вам представление.Процедура хэширования скопирована из 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
...