没有链接的VBA字典继承

Question

我想让一个字典从另一个字典继承键和值。之后，如果我修改一个字典，它不会修改另一个。我认为这是直截了当的：

Sub testdic()
    Dim d
    Set d = CreateObject("Scripting.Dictionary")
    d.Add "first", 1
    Dim s
    Set s = d
    s.Add "second", 2
End Sub

上面的代码将键“second”和值 2 添加到 s 和 d 字典中，而我希望它只添加到 s 字典中。是否可以在不创建类的情况下做到这一点？

Answer 1

这是一个更通用的解决方案，它不限制您用于键或值的内容。该函数执行字典的“浅拷贝”。它返回一个新的字典对象，但原始字典中的任何对象本质上都是通过引用传递到新字典中的。

如果原始字典中的项目不是对象（字符串、整数等），这是一个有争议的问题。但是如果项目是对象，那么对在字典之间进行浅拷贝的任何对象的更改都会更改“两个”位置的对象（我将“两个”放在引号中，因为实际上只有一个对象，只有多个引用指向它）。

Function DictionaryShallowCopy(Dict As Object) As Object           ' <-- Late-bound
'Function DictionaryShallowCopy(Dict As Dictionary) As Dictionary  ' <-- Early-bound
    If Dict Is Nothing Then Exit Function

    Set DictionaryShallowCopy = CreateObject("Scripting.Dictionary") ' <-- Late-bound
    'Set DictionaryShallowCopy = New Dictionary                      ' <-- Early-bound
    If Dict.Count = 0 Then Exit Function

    Dim Key As Variant
    For Each Key In Dict.Keys
        DictionaryShallowCopy.Add Key, Dict.Item(Key)
    Next Key

End Function

上述函数使用后期绑定，因此您不需要对脚本运行时的引用。这使您可以轻松地将此功能放入任何 VBA 项目中，而不会遇到任何麻烦。 Early-binding 会给你带来性能提升和智能感知，所以尽可能使用它是有意义的。

这是一个示例过程，说明了上述函数的作用（请注意，示例需要引用 Microsoft Scripting Runtime）。如有任何问题，请在 cmets 中提问。

Sub Sample_DictionaryShallowCopy()
    Dim A As Dictionary, A_Nothing As Dictionary
    Set A_Nothing = DictionaryDeepCopy(A)
    Debug.Print A_Nothing Is Nothing
    'True

    Set A = New Dictionary

    Dim A0 As Dictionary
    Set A0 = DictionaryDeepCopy(A)

    A.Add "Texas", "Austin"
    A.Add "New York", "Albany"

    Dim B As Dictionary
    Set B = DictionaryShallowCopy(A)
    B.Add "Pennsylvania", "Harrisburg"

    Debug.Print A0.Count, A.Count, B.Count
    ' 0             2             3

    Dim C As New Dictionary
    C.Add A, "Dictionary A"
    C.Add B, "Dictionary B"
    Dim D As Dictionary
    Set D = DictionaryShallowCopy(C)
    'The Key type is maintained during the copy, even if the key is an object:
    Debug.Print TypeName(C.Keys(0)), TypeName(D.Keys(0))
    'Dictionary    Dictionary

    Dim E As New Dictionary
    E.Add "DictA", A

    Dim F As Dictionary
    Set F = DictionaryShallowCopy(E)
    F.Add "DictB", B

    F("DictA")("Texas") = "Houston"
    'This is a shallow copy, so the items that are objects are
    '    "copied" by reference, not by value:
    Debug.Print A("Texas"), E("DictA")("Texas"), F("DictA")("Texas")
    'Houston       Houston       Houston

    'If this were a DeepCopy, then the above line would have outputted:
    'Austin        Austin        Houston
End Sub

Answer 2

为此，您需要切换键和值，以便整数是键，字符串是值。类似的东西。

Sub testdic()
    Dim d
    Set d = CreateObject("Scripting.Dictionary")
    d.Add 1, "first"
    Dim s
    Set s = CreateObject("Scripting.Dictionary")

    Dim i as long
    For i = 0 to d.Items.Count -1
        s(i) = d.Items(i)
    Next i

    s.Add 2, "second"
End Sub

This question about iterating items in a dictionary may also be of interest.