递归法实现字典解析,解决VBE环境中调试字典不便的问题

larer

平时用VBA编程时,经常需要利用字典统计和保存各种信息,但是,当数据量较大,字典嵌套,或数据结构复杂时,在VBE中要查看字典的内容就非常地不方便.
所以,我写了一个函数,可以把字典的内容显示到一个新的工作中表,可以直观地看到字典的内容,方便程序的调试.该函数采用递归法,可以显示任意多级别嵌套的字典,分享出来,方便各位编友,希望大家热情指正!

1. '递归法实现字典解析,解决VBE环境中调试字典不便的问题
   
2. '作者:larer QQ:1302230383
   
3. '参数说明:
   
4.     'ByRef dic As Variant 需要解析的字典变量
   
5.     'Optional DebugWS As Worksheet 仅供程序内部递归时指定,人工调用函数时不用指定该参数
   
6.     'Optional CellAddr 仅供程序内部递归时指定,人工调用函数时不用指定该参数
   
7.     'Optional ByRef OffsetLine As Long = 0 仅供程序内部递归时指定,人工调用函数时不用指定该参数
   
8. 
   
9. Function Debug_DisplayForDictionary(ByRef dic As Variant, Optional DebugWS As Worksheet, Optional CellAddr$, Optional ByRef OffsetLine As Long = 0)
   
10.     Dim i&
    
11.     Dim arr, brr
    
12.     Dim ActiveWs, FirstRun As Boolean
    
13.    
    
14.     If TypeName(dic) <> "Dictionary" Then Exit Function
    
15.     If CellAddr = "" Then
    
16.         With ThisWorkbook
    
17.             .Activate
    
18.             FirstRun = True
    
19.             Set ActiveWs = ActiveSheet
    
20.             For i = 1 To .Worksheets.Count
    
21.                 If .Worksheets(i).Name = "Debug_DisplayForDictionary" Then Exit For
    
22.             Next
    
23.             If i > .Worksheets.Count Then
    
24.                 .Worksheets.Add after:=.Sheets(.Sheets.Count)
    
25.                 Set DebugWS = ActiveSheet
    
26.                 With DebugWS
    
27.                     CellAddr = .Cells(1, 1).Address
    
28.                     .Name = "Debug_DisplayForDictionary"
    
29.                     .Cells.ClearContents
    
30.                 End With
    
31.             Else
    
32.                 Set DebugWS = .Worksheets(i)
    
33.                 With DebugWS
    
34.                     CellAddr = .Cells(1, 1).Address
    
35.                     .Cells.ClearContents
    
36.                 End With
    
37.             End If
    
38.         End With
    
39.     End If
    
40. 
    
41.     With DebugWS.Range(CellAddr)
    
42.         arr = dic.keys
    
43.         brr = dic.items
    
44.         For i = 0 To UBound(arr)
    
45.             .Offset(OffsetLine, 0).Value = arr(i)
    
46.             Select Case TypeName(brr(i))
    
47.                 Case "Boolean", "Byte", "Integer", "Long", "Single", "Double", "Currency", "Decimal", "Date", "String"
    
48.                     .Offset(OffsetLine, 1).Value = brr(i)
    
49.                     OffsetLine = OffsetLine + 1
    
50.                 Case "Range"
    
51.                     .Offset(OffsetLine, 1).Value = "[" & brr(i).Address & "]"
    
52.                     OffsetLine = OffsetLine + 1
    
53.                 Case "Dictionary"
    
54.                     Call Debug_DisplayForDictionary(brr(i), DebugWS, .Offset(0, 1).Address, OffsetLine)
    
55.                 Case Else
    
56.                     .Offset(OffsetLine, 1).Value = "(" & TypeName(brr(i)) & ")"
    
57.                     OffsetLine = OffsetLine + 1
    
58.             End Select
    
59.         Next
    
60.     End With
    
61.    
    
62.     If FirstRun Then
    
63.         ActiveWs.Activate
    
64.     End If
    
65. End Function

复制代码

'调用示例:

1. Sub Example()
   
2.     Dim dic
   
3.    
   
4.     Set dic = createobject("scripting.dictionary")
   
5.     dic("张三") = "总经理"
   
6.     Set dic("李四") = createobject("scripting.dictionary")
   
7.     dic("李四")("性别") = "男"
   
8.     dic("李四")("生日") = "1980/1/1"
   
9.     dic("李四")("职务") = "采购员"
   
10.     Set dic("李四")("亲属") = createobject("scripting.dictionary")
    
11.     Set dic("李四")("亲属")("妻子") = createobject("scripting.dictionary")
    
12.     dic("李四")("亲属")("妻子")("工作单位") = "图书馆"
    
13.     Set dic("李四")("亲属")("妻子")("亲属") = createobject("scripting.dictionary")
    
14.     dic("李四")("亲属")("妻子")("亲属")("弟弟") = "张磊"
    
15.     dic("李四")("亲属")("妻子")("亲属")("哥哥") = "张三"
    
16.     dic("李四")("亲属")("儿子") = "小明"
    
17. 
    
18.     Debug_DisplayForDictionary dic '此句为调用函数解析字典
    
19. End Sub

复制代码

程序运行结果是,在当前工作薄中自动建立了一个名为"Debug_DisplayForDictionary"工作表,并在工作表中显示该字典的内容.

larer

当字典中的值是一个对象时,如果是range类型,就显示其地址,如果是其它类型,则显示其类型.

larer

自顶一个.希望大家多交流!

kuangben8

字典嵌套一直不太明白的原因就是值看不见！感谢分享！

zopey

从例子看，建立多个字典对象  ，定义过程 些许复杂。我的想法是 1个 字典（key=人名） 完全显示复杂数据的结构 （item= 多个项目）。

microyip

如果数据太大，不要用字典哦，会把人都卡疯的。但贴主的是好帖，点个赞

larer

zopey 发表于 2019-4-17 15:03
从例子看，建立多个字典对象  ，定义过程 些许复杂。我的想法是 1个 字典（key=人名） 完全显示复杂数据的 ...

谢谢点评.我举那个例子,是为了测试该函数的效果,平时里用字典,很少这样的结构,你看得挺仔细.

cui26896

这个好啊，比自己做循环来看要直观得多，好东西！

opel-wong

高级字典应用，学习了。

xiaomils

你好，我没有权限添加好友，你加我是为了？？