6VBA嵌套字典的递归输出(序列化)
作者:AntoniotheFuture
关键词:VBA,字典,Dictionary,嵌套,递归,序列化
开发平台:VBE
平台版本上限:未知
平台版本下限:未知
开发语言:VBA
简介: 用递归的方法将一个VBA的嵌套字典对象全部输出到文本框内。
最近笔者的工作中使用到了VBA的Dictionary(字典)对象,这种对象是一种键值对对象,表现形式为:key:item ,其中Key是不可重复的,item也可以为另外一个字典,多个字典嵌套所形成的对象可以让我很方便地操作一个类,我在这一个对象内完成大部分的动作,极大地简化了我的代码。
要创建这样的对象,只需要像下面这样做就行了:
- Dim AllDic as object
- Dim PeopleDic as object
- Dim HousesDic as object
- Dim HouseDic as object
- Dim RommDic as object
- set AllDic = CreateObject('Scripting.Dictionary')
- set PeopleDic = CreateObject('Scripting.Dictionary')
- set HousesDic = CreateObject('Scripting.Dictionary')
- set HouseDic = CreateObject('Scripting.Dictionary')
- set RommDic = CreateObject('Scripting.Dictionary')
- RommDic.add 1,'客厅'
- RommDic.add 2,'主卧'
- RommDic.add 3,'厨房'
- HouseDic.add 'Addr','中山路3号'
- HouseDic.add 'Price','120万'
- HouseDic.add 'Rooms',RommDic
- HousesDic.add 1,HouseDic
- RommDic.removeall
- HouseDic.removeall
- RommDic.add 1,'客厅'
- RommDic.add 2,'主卧'
- RommDic.add 3,'阳台'
- HouseDic.add 'Addr','西安路58号'
- HouseDic.add 'Price','90万'
- HouseDic.add 'Rooms',RommDic
- HousesDic.add 2,HouseDic
- PeopleDic.add 'Name','王明'
- PeopleDic.add 'BirthDate','1990-01-01'
- PeopleDic.add 'Horses',HousesDic
- AllDic.add 1,PeopleDic
- RommDic.removeall
- HouseDic.removeall
- HousesDic.removeall
- PeopleDic.removeall
- RommDic.add 1,'客厅'
- RommDic.add 2,'主卧'
- RommDic.add 3,'次卧1'
- HouseDic.add 'Addr','北京路159号'
- HouseDic.add 'Price','145万'
- HouseDic.add 'Rooms',RommDic
- HousesDic.add 1,HouseDic
- PeopleDic.add 'Name','李红'
- PeopleDic.add 'BirthDate','1980-10-01'
- PeopleDic.add 'Horses',HousesDic
- 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中的本地窗口中是无法展开的,调试起来很麻烦。
这时我们就需要下面的代码来将其打包成结构式的文本,采用了递归方法,无论有多少层都能处理哦。(完)
- Sub NestingDictoString()
- Dim DicT as String
- Dim ParentDic as Object
- Dim TreeDic as object
- Dim i,ii
- Dim Str
- Dim OldKey
- TextBox1.text = ''
- Dic = '字典结构' & chr(10)
- Set ParentDic = CreateObject('Scripting.Dictionary')
- Set TreeDic = CreateObject('Scripting.Dictionary')
- '先把要打包的字典放到过程变量中:
- For each DC in TabDic
- ParentDic.add DC,TabDic(DC)
- Next
- i = 0
- Do while i < ParentDic.Count
- Key = ParentDic.Keys
- '判断是否嵌套了字典,如果是,把子字典加到主遍历中(递归)
- If TypeName(ParentDic(Key(i))) = 'Dictionary' then
- TreeDic.add TreeDic.Count,Key(i) & 'i'
- For Each DC in ParentDic(Key(i))
- ParentDic.add Key(i) & ';' & DC,ParentDic(Key(i))(DC)
- Next
- For ii = i 1 to ParentDic.Count - ParentDic(Key(i)).Count - 1
- '把父字典放到最后,调整顺序
- OldKey = Key(ii)
- ParentDic.Add '-LAST-',ParentDic(OldKey)
- ParentDic.Remove(OldKey)
- ParentDic.Key('-LAST-') = OldKey
- Next
- Else
- TreeDic.add TreeDic.Count,Key(i) & ':' & ParentDic(Key(i))
- End if
- Loop
- '下面拼接为字符串[Chr(9)为Tab键]:
- For ii = 0 to TreeDic.Count - 1
- i = UBound(Split(TreeDic(ii),';'))
- DicT = DicT & String(i,Chr(9)) & Split(TreeDic(ii),';')(i) & chr(10)
- Next
- TextBox1.Text = DicT
- End Sub
联系客服