VBA多层嵌套字典中数组更新异常问题排查

问题说明 #

创建了键结构为team>member>mth的多层嵌套Scripting.Dictionary，值以数组存储，可通过mydict(team)(member)(mth)(0或1)访问。但通过临时数组循环更新数组元素时，所有嵌套项的数组值被同步修改，结果不符合预期。

完整VBA代码 #

Sub test()

Dim mydict1 As New Scripting.Dictionary
Dim mydict2 As New Scripting.Dictionary
Dim mydict3 As New Scripting.Dictionary
Dim mydict4 As New Scripting.Dictionary

For Each mth In Array(1, 2)
    mydict3.Add mth, Array("NA", "NA")
Next mth

For Each member In Array(11, 22, 33)
    mydict4.Add member, mydict3
Next member

For Each team In Array(1, 2)
mydict1.Add team, mydict4
Next team

i = 1

For Each team In mydict1.Keys()
    For Each member In mydict1(team).Keys()
        For Each mth In mydict1(team)(member).Keys()

                Dim tmparr As Variant

                tmparr = mydict1(team)(member)(mth)
                tmparr(0) = i
                mydict1(team)(member)(mth) = tmparr
                Debug.Print mth & "---" & team & "---" & member & "---" & Join(mydict1(team)(member)(mth), "---")
                i = i + 1
            
        Next mth
    Next member
Next team


Debug.Print "================================================='"

For Each team In mydict1.Keys()
    For Each member In mydict1(team).Keys()
        For Each mth In mydict1(team)(member).Keys()
                Debug.Print mth & "---" & team & "---" & member & "---" & Join(mydict1(team)(member)(mth), "---")
        Next mth
    Next member
Next team

End Sub

实际输出 #

1---1---11---11---NA
2---1---11---12---NA
1---1---22---11---NA
2---1---22---12---NA
1---1---33---11---NA
2---1---33---12---NA
1---2---11---11---NA
2---2---11---12---NA
1---2---22---11---NA
2---2---22---12---NA
1---2---33---11---NA
2---2---33---12---NA

期望输出 #

1---1---11---1---NA
2---1---11---2---NA
1---1---22---3---NA
2---1---22---4---NA
1---1---33---5---NA
2---1---33---6---NA
1---2---11---7---NA
2---2---11---8---NA
1---2---22---9---NA
2---2---22---10---NA
1---2---33---11---NA
2---2---33---12---NA

问题原因及解决方案 #

原因 #

VBA中Scripting.Dictionary是对象，赋值时采用引用传递而非值传递。原代码里：

• 所有member对应的字典都是同一个mydict3的引用
• 所有team对应的字典都是同一个mydict4的引用
  所以修改任意一个member下的数组值，会同步影响所有member的对应项；同理修改任意team下的内容，也会影响所有team的对应项。

修正代码 #

把内层字典的创建逻辑放到循环内部，确保每个member和team都拥有独立的字典实例：

Sub test()

Dim mydict1 As New Scripting.Dictionary
Dim mydict4 As Scripting.Dictionary ' 外层member字典
Dim mydict3 As Scripting.Dictionary ' 内层mth字典

For Each team In Array(1, 2)
    Set mydict4 = New Scripting.Dictionary ' 每个team新建独立的member字典
    For Each member In Array(11, 22, 33)
        Set mydict3 = New Scripting.Dictionary ' 每个member新建独立的mth字典
        For Each mth In Array(1, 2)
            mydict3.Add mth, Array("NA", "NA")
        Next mth
        mydict4.Add member, mydict3
    Next member
    mydict1.Add team, mydict4
Next team

i = 1

For Each team In mydict1.Keys()
    For Each member In mydict1(team).Keys()
        For Each mth In mydict1(team)(member).Keys()
                Dim tmparr As Variant
                tmparr = mydict1(team)(member)(mth)
                tmparr(0) = i
                mydict1(team)(member)(mth) = tmparr
                Debug.Print mth & "---" & team & "---" & member & "---" & Join(mydict1(team)(member)(mth), "---")
                i = i + 1
        Next mth
    Next member
Next team

Debug.Print "================================================='"

For Each team In mydict1.Keys()
    For Each member In mydict1(team).Keys()
        For Each mth In mydict1(team)(member).Keys()
                Debug.Print mth & "---" & team & "---" & member & "---" & Join(mydict1(team)(member)(mth), "---")
        Next mth
    Next member
Next team

End Sub

修正后效果 #

运行修正后的代码，输出将与期望输出完全一致，每个team>member>mth对应的数组都会被独立更新。

内容的提问来源于stack exchange，提问作者Alana