楼主
wcymiss |
与大家分享vba字典嵌套用法一例。将字典的item值再定义为一字典。
如图，字典嵌套可以同时对B列数据按A列内容进行汇总到E列和按C列内容进行汇总到F列。见以下黄色部分效果：
vba代码如下:
- Sub justtest()
- Dim d, arr, i&, t&, arrt(), s$, dd
- Set d = CreateObject("scripting.dictionary") '定义父字典对象
- Const st$ = "其中返入到"
- t = Cells(Rows.Count, 1).End(3).Row - 1 'A列需要处理的有效数据个数（最后行号减去标题行）
- arr = Range("a2:c" & t + 1).Value '将A至C列数据赋值给数组arr
- For i = 1 To t '循环处理arr
- If Len(Trim(arr(i, 1))) Then '如果数组arr不为空（既A列不为空）则：
- If Not d.Exists(arr(i, 1)) Then
- d.Add arr(i, 1), 1 '将A列值（数组arr）装入父字典
- Set d(arr(i, 1)) = CreateObject("scripting.dictionary") '同时定义每个父字典元素的子字典
- End If
- If d(arr(i, 1)).Exists(arr(i, 3)) Then
- '如果子字典未赋值，则将C列值作为其key值，B列值作为其item值进行赋值；否则将item加上B列值
- d(arr(i, 1))(arr(i, 3)) = d(arr(i, 1))(arr(i, 3)) + arr(i, 2)
- Else: d(arr(i, 1)).Add arr(i, 3), arr(i, 2)
- End If
- End If
- Next
- If d.Count > 0 Then '如果父字典个数大于0
- arr = d.keys: ReDim arrt(UBound(arr), 1 To 3) '重定义数组大小，以备生成E：G列数据
- For i = 0 To UBound(arr)
- s = ""
- arrt(i, 1) = arr(i)
- arrt(i, 2) = Application.Sum(d(arr(i)).Items) '合计总数量
- For Each dd In d(arr(i)).keys
- If dd <> "" Then s = s & "、" & dd & "：" & d(arr(i))(dd) & "吨"
- Next
- arrt(i, 3) = IIf(s = "", "", st & Mid(s, 2)) '对子字典key值进行处理，处理成G列数据
- Next
- Range("e2:g" & Rows.Count).ClearContents '清除E：G列
- Range("e2").Resize(i, 3) = arrt '拷贝数组到F：G列
- End If
- Set d = Nothing
- End Sub
 字典嵌套实例.rar
|