VBA 深度克隆字典 - VBA

在 VBA 中，字典是一个非常实用的数据结构，它能够快速地存储和查找键值对。但是，在某些情况下，我们需要对字典进行深度克隆，即创建一个与原字典相同但不共享内部数据的新字典。

以下是一个实现 VBA 字典深度克隆的代码示例。它使用递归的方式遍历原字典，并使用 Set 语句创建新字典。

Sub CloneDict(ByRef originalDict As Scripting.Dictionary, ByRef clonedDict As Scripting.Dictionary)
    ' 创建新字典
    Set clonedDict = New Scripting.Dictionary
    
    ' 遍历原字典并逐个拷贝键值对
    Dim key As Variant
    For Each key In originalDict.Keys
        If IsObject(originalDict(key)) Then
            ' 如果值是对象，则递归拷贝对象
            If TypeName(originalDict(key)) = "Dictionary" Then
                ' 如果值是字典，则递归拷贝字典
                Dim clonedSubDict As Scripting.Dictionary
                CloneDict originalDict(key), clonedSubDict
                clonedDict.Add key, clonedSubDict
            Else
                ' 否则递归拷贝其他类型的对象
                Dim clonedObj As Object
                Call CloneObject(originalDict(key), clonedObj)
                clonedDict.Add key, clonedObj
            End If
        Else
            ' 如果值不是对象，则直接拷贝
            clonedDict.Add key, originalDict(key)
        End If
    Next
End Sub

Sub CloneObject(ByRef originalObj As Object, ByRef clonedObj As Object)
    ' 使用 CopyMemory 函数复制对象的二进制数据
    Dim objData() As Byte
    ReDim objData(0 To LenB(originalObj) - 1) As Byte
    CopyMemory objData(0), ByVal ObjPtr(originalObj), LenB(originalObj)
    ' 创建新对象并将复制的数据写入其中
    Call VarPtrToObj(ObjPtr(clonedObj), clonedObj)
    CopyMemory ByVal ObjPtr(clonedObj), objData(0), LenB(originalObj)
End Sub

为了测试这个方法，我们可以编写以下代码来创建一个字典并深度克隆它：

Sub TestCloneDict()
    ' 创建原字典
    Dim origDict As New Scripting.Dictionary
    origDict.Add "key1", "value1"
    origDict.Add "key2", "value2"
    Dim subDict As New Scripting.Dictionary
    subDict.Add "subKey1", "subValue1"
    subDict.Add "subKey2", "subValue2"
    origDict.Add "key3", subDict
    
    ' 克隆字典
    Dim clonedDict As Scripting.Dictionary
    CloneDict origDict, clonedDict
    
    ' 修改原字典并输出结果
    origDict("key1") = "newValue"
    subDict("subKey1") = "newSubValue"
    Debug.Print "original dictionary:"
    PrintDict origDict
    Debug.Print "cloned dictionary:"
    PrintDict clonedDict
End Sub

Sub PrintDict(ByRef dict As Scripting.Dictionary)
    Dim key As Variant
    For Each key In dict.Keys
        Debug.Print key & ": " & dict(key)
        If TypeName(dict(key)) = "Dictionary" Then
            Call PrintDict(dict(key))
        End If
    Next
End Sub

这个测试代码将输出以下内容：

original dictionary:
key1: newValue
key2: value2
key3: subKey1: newSubValue
      subKey2: subValue2
cloned dictionary:
key1: value1
key2: value2
key3: subKey1: subValue1
      subKey2: subValue2

如我们所见，修改原字典并不会影响克隆字典。同时，克隆字典也成功地复制了原字典中的所有键值对。

这样，我们就完成了 VBA 字典深度克隆的实现。