字典嵌套与递归的混合应用教程范例

microyip

最近，看到了“月关”坛友对字典嵌套的热衷，今天又刚好有个坛友问及字典嵌套的应用，突然想弄个字典嵌套与递归的混合应用教程范例出来的冲动。
先看看本帖二楼的常规字典嵌套的应用，代码也不是很复杂，也易于理解，但存在一个缺陷，对字典嵌套层数必须用手工一层层写进代码里。
利用递归方式写字典嵌套，就可以相对简单解决层数问题了，就代码相对复杂了点。
其中，代码中关于建设字典过程基本是没问题的，但递归应用字典代码中，我已知有一定的Bug，但具体这个Bug在实际应用会不会产生呢？暂时不知道，所以我也没有预先设置代码去处理了。如果有朋友专门指出或者其他我未知的Bug，欢迎提出指正。

1. Sub 递归建立字典嵌套示例()
   
2.     Dim oDic As Object, vKey As Variant, vMsg As Variant, sMsg As String
   
3.     Dim vData As Variant, nRow As Long, nCol As Long
   
4.    
   
5.     vData = [{"广东省","深圳市","罗湖区";"广东省","深圳市","宝安区";"广东省","广州市","海珠区";"广东省","广州市","白云区"}]
   
6.         '需要设置字典的数据
   
7.     For nRow = 1 To UBound(vData)
   
8.         vKey = Application.WorksheetFunction.Index(vData, nRow) '获取字典设置需要的关键字数组
   
9.         Set oDic = SetDic(oDic, vKey, nRow) '对vKey指定关键字进行字典层级设置
   
10.     Next
    
11.    
    
12.     vData = [{"广东省","深圳市","罗湖区";"广东省","广州市","东山区";"广东省","珠海市","香山区";"浙江省","杭州市","西湖区"}]
    
13.         '需要检索字典的结果
    
14.     For nRow = 1 To UBound(vData)
    
15.         vKey = Application.WorksheetFunction.Index(vData, nRow) '检索字典的关键字数组
    
16.         vMsg = GetDicMsg(oDic, vKey) '获取指定关键字在检索字典过程中的信息
    
17.         If vMsg(3) = "" Then
    
18.             sMsg = "【" & vMsg(2) & "】的数据排序是：" & vMsg(1)
    
19.         Else '存在出错关键字
    
20.             If Not vMsg(4) Then  '当存在最后关键字得到是字典
    
21.                 sMsg = "数据内存在【"
    
22.                 If vMsg(2) <> "" Then sMsg = sMsg & vMsg(2) & "，"
    
23.                 sMsg = sMsg & vMsg(3) & "】，但不是一个最终值"
    
24.             Else
    
25.                 sMsg = "数据内不存在【"
    
26.                 If vMsg(2) <> "" Then sMsg = sMsg & vMsg(2) & "】的【"
    
27.                 sMsg = sMsg & vMsg(3) & "】"
    
28.             End If
    
29.         End If
    
30.         If sMsg <> "" Then MsgBox sMsg
    
31.     Next
    
32. End Sub
    
33. 
    
34. Private Function SetDic(ByVal oDic As Variant, ByVal vKey As Variant, Optional ByVal vItem As Variant, Optional ByVal nIndex As Long) As Object
    
35. 'oDic，设定的字典初始状态
    
36. 'vKey，字典的关键字或者关键字数组
    
37. 'vItem，字典最终设置的Item值
    
38. 'nIndex，需要设置的字典层数
    
39.     If IsMissing(vItem) Then '当函数接收的vItem参数没有被传过来参数值时
    
40.         vItem = Empty '预设一个参数值
    
41.     End If
    
42.     If TypeName(oDic) <> "Dictionary" Then '参数oDic的类型不是字典类型时
    
43.         Set oDic = CreateObject("Scripting.Dictionary") '设置oDic为一个新字典
    
44.     End If
    
45.     If IsArray(vKey) Then 'vKey是数组时
    
46.         If nIndex = 0 Then '当函数接收的nIndex参数没有被传过来参数值时
    
47.             nIndex = LBound(vKey) '获取第一层关键字数组的序号
    
48.         End If
    
49.         If nIndex = UBound(vKey) Then '需要设置的字典层数为最大关键字数组序号时
    
50.             oDic(vKey(nIndex)) = vItem '建立字典
    
51.         Else
    
52.             Set oDic(vKey(nIndex)) = SetDic(oDic(vKey(nIndex)), vKey, vItem, nIndex + 1) '建立下一层字典
    
53.         End If
    
54.     Else 'vKey不是数组时
    
55.         oDic(vKey) = vItem '建立字典
    
56.     End If
    
57.     Set SetDic = oDic '返回已建立的字典
    
58. End Function
    
59. 
    
60. Private Function GetDicMsg(ByVal oDic As Object, ByVal vKey As Variant, Optional ByVal vMsg As Variant, Optional ByVal nIndex As Long) As Variant
    
61. 'oDic，匹配数据的字典
    
62. 'vKey，字典的关键字或者关键字数组
    
63. 'vMsg，返回用的信息
    
64. 'nIndex，需要设置的字典层数
    
65.     Dim nI As Long, vKey_Now As Variant
    
66.    
    
67.     If IsMissing(vMsg) Then '当函数接收的vMsg参数没有被传过来参数值时
    
68.         ReDim vMsg(1 To 4) '重置数组，1、最终的Item结果；2、能获取的关键字；3、不能获取的关键字或获取的关键字得到的是一个字典；4、最终Item结果不是字典
    
69.         vMsg(4) = True
    
70.     End If
    
71.     If IsArray(vKey) Then 'vKey是数组时
    
72.         If nIndex = 0 Then '当函数接收的nIndex参数没有被传过来参数值时
    
73.             nIndex = LBound(vKey) '获取第一层关键字数组的序号
    
74.         End If
    
75.         vKey_Now = vKey(nIndex) '当前的关键字值
    
76.         If oDic.Exists(vKey_Now) Then '存在对应层字典的关键字
    
77.             If nIndex = UBound(vKey) Then '需要读取的字典层数为最大关键字数组序号时
    
78.                 vMsg(4) = TypeName(oDic(vKey_Now)) <> "Dictionary" '当前关键字得到的是否字典类型
    
79.                 If vMsg(4) Then '当前关键字的不是字典类型
    
80.                     vMsg(1) = oDic(vKey_Now) '记录最终的Item结果
    
81.                     If vMsg(2) <> "" Then vMsg(2) = vMsg(2) & "，"
    
82.                     vMsg(2) = vMsg(2) & vKey_Now '记录获取的关键字
    
83.                 Else
    
84.                     vMsg(3) = vKey_Now '记录获取的关键字得到的是一个字典
    
85.                 End If
    
86.             Else
    
87.                 If vMsg(2) <> "" Then vMsg(2) = vMsg(2) & "，"
    
88.                 vMsg(2) = vMsg(2) & vKey_Now '记录获取的关键字
    
89.                 vMsg = GetDicMsg(oDic(vKey_Now), vKey, vMsg, nIndex + 1) '对下一层级的字典检索
    
90.             End If
    
91.         Else
    
92.             vMsg(3) = vKey_Now '记录不能获取的关键字
    
93.         End If
    
94.     Else 'vKey不是数组时
    
95.         If oDic.Exists(vKey) Then
    
96.             vMsg(4) = TypeName(oDic(vKey)) <> "Dictionary" '当前关键字得到的是否字典类型
    
97.             If vMsg(4) Then '当前关键字的不是字典类型
    
98.                 vMsg(1) = oDic(vKey) '记录最终的Item结果
    
99.                 vMsg(2) = vKey '记录获取的关键字
    
100.             Else
     
101.                 vMsg(3) = vKey '记录获取的关键字得到的是一个字典
     
102.             End If
     
103.         Else
     
104.             vMsg(3) = vKey '记录不能获取的关键字
     
105.         End If
     
106.     End If
     
107.     GetDicMsg = vMsg '返回信息
     
108. End Function

复制代码

附上附件以供参考
递归建立字典嵌套示例(by.micro).rar (22.92 KB, 下载次数: 126)

2019-10-21 17:42 上传

点击文件名下载附件

microyip

常规字典嵌套应用

1. Sub 常规建立字典嵌套示例()
   
2.     Dim oDic As Object, vKey As Variant, vItem As Variant
   
3.     Dim vData As Variant, nRow As Long, nCol As Long
   
4.    
   
5.     vData = [{"广东省","深圳市","罗湖区";"广东省","深圳市","宝安区";"广东省","广州市","海珠区";"广东省","广州市","白云区"}]
   
6.     Set oDic = CreateObject("Scripting.Dictionary")
   
7.     ReDim vKey(1 To UBound(vData, 2))
   
8.     For nRow = 1 To UBound(vData)
   
9.         vKey = Application.WorksheetFunction.Index(vData, nRow)
   
10.         If Not oDic.Exists(vKey(1)) Then Set oDic(vKey(1)) = CreateObject("Scripting.Dictionary")
    
11.         If Not oDic(vKey(1)).Exists(vKey(2)) Then Set oDic(vKey(1))(vKey(2)) = CreateObject("Scripting.Dictionary")
    
12.         oDic(vKey(1))(vKey(2))(vKey(3)) = nRow
    
13.     Next
    
14.    
    
15.    
    
16.     vData = [{"广东省","深圳市","罗湖区";"广东省","广州市","东山区";"广东省","珠海市","香山区";"浙江省","杭州市","西湖区"}]
    
17.     For nRow = 1 To UBound(vData)
    
18.         vKey = Application.WorksheetFunction.Index(vData, nRow)
    
19.         If oDic.Exists(vKey(1)) Then
    
20.             If oDic(vKey(1)).Exists(vKey(2)) Then
    
21.                 If oDic(vKey(1))(vKey(2)).Exists(vKey(3)) Then
    
22.                     MsgBox "【" & vKey(1) & "，" & vKey(2) & "，" & vKey(3) & "】的数据排序是：" & oDic(vKey(1))(vKey(2))(vKey(3))
    
23.                 Else
    
24.                     MsgBox "数据内不存在【" & vKey(1) & "，" & vKey(2) & "】的【" & vKey(3) & "】"
    
25.                 End If
    
26.             Else
    
27.                 MsgBox "数据内不存在【" & vKey(1) & "】的【" & vKey(2) & "】"
    
28.             End If
    
29.         Else
    
30.             MsgBox "数据内不存在【" & vKey(1) & "】"
    
31.         End If
    
32.     Next
    
33. End Sub

复制代码

月关

感谢感谢！十分感谢老师用心良苦，我就当为我量身订制的了，话说 老师怎么知道我要开始学递归呢。

字典已经告一段落了，话说这块以后我就是大神了，涉及到字典的问题随便喊我过来指导昂各位………
前面疑似飞过来一块砖状物，我先战略性地回避一下

jxwfz740724

看着，小白求学中。

pengs14

顶！！！！！！！

mikewong123

不错不错！！！

笨鸟飞不高

先留个记号！！

yzxfelix

能给建立个多层嵌套的模型吗

jhegzwjb2016

感谢老师的无私分享！