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')
  11. RommDic.add 1,'客厅'
  12. RommDic.add 2,'主卧'
  13. RommDic.add 3,'厨房'
  14. HouseDic.add 'Addr','中山路3号'
  15. HouseDic.add 'Price','120万'
  16. HouseDic.add 'Rooms',RommDic
  17. HousesDic.add 1,HouseDic
  18. RommDic.removeall
  19. HouseDic.removeall
  20. RommDic.add 1,'客厅'
  21. RommDic.add 2,'主卧'
  22. RommDic.add 3,'阳台'
  23. HouseDic.add 'Addr','西安路58号'
  24. HouseDic.add 'Price','90万'
  25. HouseDic.add 'Rooms',RommDic
  26. HousesDic.add 2,HouseDic
  27. PeopleDic.add 'Name','王明'
  28. PeopleDic.add 'BirthDate','1990-01-01'
  29. PeopleDic.add 'Horses',HousesDic
  30. AllDic.add 1,PeopleDic
  31. RommDic.removeall
  32. HouseDic.removeall
  33. HousesDic.removeall
  34. PeopleDic.removeall
  35. RommDic.add 1,'客厅'
  36. RommDic.add 2,'主卧'
  37. RommDic.add 3,'次卧1'
  38. HouseDic.add 'Addr','北京路159号'
  39. HouseDic.add 'Price','145万'
  40. HouseDic.add 'Rooms',RommDic
  41. HousesDic.add 1,HouseDic
  42. PeopleDic.add 'Name','李红'
  43. PeopleDic.add 'BirthDate','1980-10-01'
  44. PeopleDic.add 'Horses',HousesDic
  45. AllDic.add 2,PeopleDic

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

  1. AllDic:
  2. 1:
  3. Name:'王明'
  4. BirthDate:'1990-01-01'
  5. Horses:
  6. 1:
  7. Addr:'中山路3号'
  8. Price:'120万'
  9. Rooms:
  10. 1:'客厅'
  11. 2:'主卧'
  12. 3,'厨房'
  13. 2:
  14. Addr:'西安路58号'
  15. Price:'90万'
  16. Rooms:
  17. 1:'客厅'
  18. 2:'主卧'
  19. 3,'阳台'
  20. 2:
  21. Name:'李红'
  22. BirthDate:'1980-10-01'
  23. Horses:
  24. 1:
  25. Addr:'北京路159号'
  26. Price:'145万'
  27. Rooms:
  28. 1:'客厅'
  29. 2:'主卧'
  30. 3,'次卧1'

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

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

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

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

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

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

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

相关推荐