VBA嵌套字典的递归输出（序列化）

6VBA嵌套字典的递归输出（序列化）

作者：AntoniotheFuture

关键词：VBA，字典，Dictionary，嵌套，递归，序列化

开发平台：VBE

平台版本上限：未知

平台版本下限：未知

开发语言：VBA

简介： 用递归的方法将一个VBA的嵌套字典对象全部输出到文本框内。

最近笔者的工作中使用到了VBA的Dictionary（字典）对象，这种对象是一种键值对对象，表现形式为：key:item ，其中Key是不可重复的，item也可以为另外一个字典，多个字典嵌套所形成的对象可以让我很方便地操作一个类，我在这一个对象内完成大部分的动作，极大地简化了我的代码。

要创建这样的对象，只需要像下面这样做就行了：

1. Dim AllDic as object
2. Dim PeopleDic as object
3. Dim HousesDic as object
4. Dim HouseDic as object
5. Dim RommDic as object
6. set AllDic = CreateObject('Scripting.Dictionary')
7. set PeopleDic = CreateObject('Scripting.Dictionary')
8. set HousesDic = CreateObject('Scripting.Dictionary')
9. set HouseDic = CreateObject('Scripting.Dictionary')
10. set RommDic = CreateObject('Scripting.Dictionary')
12. RommDic.add 1,'客厅'
13. RommDic.add 2,'主卧'
14. RommDic.add 3,'厨房'
15. HouseDic.add 'Addr','中山路3号'
16. HouseDic.add 'Price','120万'
17. HouseDic.add 'Rooms',RommDic
19. HousesDic.add 1,HouseDic
21. RommDic.removeall
22. HouseDic.removeall
24. RommDic.add 1,'客厅'
25. RommDic.add 2,'主卧'
26. RommDic.add 3,'阳台'
27. HouseDic.add 'Addr','西安路58号'
28. HouseDic.add 'Price','90万'
29. HouseDic.add 'Rooms',RommDic
30. HousesDic.add 2,HouseDic
32. PeopleDic.add 'Name','王明'
33. PeopleDic.add 'BirthDate','1990-01-01'
34. PeopleDic.add 'Horses',HousesDic
36. AllDic.add 1,PeopleDic
38. RommDic.removeall
39. HouseDic.removeall
40. HousesDic.removeall
41. PeopleDic.removeall
43. RommDic.add 1,'客厅'
44. RommDic.add 2,'主卧'
45. RommDic.add 3,'次卧1'
46. HouseDic.add 'Addr','北京路159号'
47. HouseDic.add 'Price','145万'
48. HouseDic.add 'Rooms',RommDic
49. HousesDic.add 1,HouseDic
50. PeopleDic.add 'Name','李红'
51. PeopleDic.add 'BirthDate','1980-10-01'
52. PeopleDic.add 'Horses',HousesDic
54. AllDic.add 2,PeopleDic

这样我们创建了AllDic这样一个嵌套的字典，他的实际内容是这样的：

AllDic:
    1:
        Name:'王明'
        BirthDate:'1990-01-01'
        Horses:
            1:
                Addr:'中山路3号'
                Price:'120万'
                Rooms:
                    1:'客厅'
                    2:'主卧'
                    3,'厨房'
            2:
                Addr:'西安路58号'
                Price:'90万'
                Rooms:
                    1:'客厅'
                    2:'主卧'
                    3,'阳台'
    2:
        Name:'李红'
        BirthDate:'1980-10-01'
        Horses:
            1:
                Addr:'北京路159号'
                Price:'145万'
                Rooms:
                    1:'客厅'
                    2:'主卧'
                    3,'次卧1'

这是一个四层的字典，第二层是人，第三层是房子，第四层是房间，需要引用里面的信息时，只需要像这样就行了：

第一个人第二套房子的地址：AllDic(1)('Horses')(2)('Addr')

第二个人的生日：AllDic(2)('BirthDate')

这种结构是不是似曾相识呢？对的，他就像Json。

现在进入正题，这个结构是保存在内存中的，如何打包为字符串进行查看和保存？而且这个结构在VBE中的本地窗口中是无法展开的，调试起来很麻烦。

这时我们就需要下面的代码来将其打包成结构式的文本，采用了递归方法，无论有多少层都能处理哦。(完)

1. Sub NestingDictoString()
3. Dim DicT as String
4. Dim ParentDic as Object
5. Dim TreeDic as object
6. Dim i,ii
7. Dim Str
8. Dim OldKey
9. TextBox1.text = ''
10. Dic = '字典结构' & chr(10)
11. Set ParentDic = CreateObject('Scripting.Dictionary')
12. Set TreeDic = CreateObject('Scripting.Dictionary')
13. '先把要打包的字典放到过程变量中：
14. For each DC in TabDic
15. ParentDic.add DC,TabDic(DC)
16. Next
17. i = 0
18. Do while i < ParentDic.Count
19. Key = ParentDic.Keys
20. '判断是否嵌套了字典，如果是，把子字典加到主遍历中(递归)
21. If TypeName(ParentDic(Key(i))) = 'Dictionary' then
22. TreeDic.add TreeDic.Count,Key(i) & 'i'
23. For Each DC in ParentDic(Key(i))
24. ParentDic.add Key(i) & ';' & DC,ParentDic(Key(i))(DC)
25. Next
26. For ii = i 1 to ParentDic.Count - ParentDic(Key(i)).Count - 1
27. '把父字典放到最后，调整顺序
28. OldKey = Key(ii)
29. ParentDic.Add '-LAST-',ParentDic(OldKey)
30. ParentDic.Remove(OldKey)
31. ParentDic.Key('-LAST-') = OldKey
32. Next
33. Else
34. TreeDic.add TreeDic.Count,Key(i) & ':' & ParentDic(Key(i))
35. End if
36. Loop
37. '下面拼接为字符串[Chr(9)为Tab键]：
38. For ii = 0 to TreeDic.Count - 1
39. i = UBound(Split(TreeDic(ii),';'))
40. DicT = DicT & String(i,Chr(9)) & Split(TreeDic(ii),';')(i) & chr(10)
41. Next
42. TextBox1.Text = DicT
43. End Sub