请教字典嵌套如何将子key和子item返回到单元格区域

autumnalRain

本人正学习香川老师的 字典基本语句、以及中级字典运用例子
http://club.excelhome.net/thread-1154595-1-1.html

无奈实在愚顿，照着老师的例子改自己的代码也报错，有请各位老师就着本例子指点迷津，十分感谢！
如何输出嵌套字典的子KEY和子item？

1. Sub 字典嵌套()'On Error Resume Next
   
2. Dim dic As Object, i As Long
   
3. arr = Range([a2], [c2].End(xlDown))
   
4. 
   
5. Set dic = CreateObject("Scripting.Dictionary")
   
6. 
   
7. For i = 1 To UBound(arr) '设置字典嵌套
   
8.     Set dic(arr(i, 1)) = CreateObject("Scripting.Dictionary")
   
9. Next
   
10. 
    
11. krr = dic.keys
    
12. For i = 1 To UBound(arr)
    
13.      dic(arr(i, 1))(arr(i, 2)) = dic(arr(i, 1))(arr(i, 2)) + arr(i,3)
    
14. Next
    
15. 
    
16. ReDim kr(0 To dic.Count - 1) '定义数组kr存放嵌套子字典中的【子key】
    
17. ReDim tr(0 To dic.Count - 1) '定义数组tr存放嵌套子字典中的【子item】
    
18. For i = 0 To dic.Count - 1
    
19.     kr(i) = dic(krr(i)).keys
    
20.     tr(i) = dic(krr(i)).items
    
21. Next
    
22. 
    
23. 'k = kr
    
24. 't = tr
    
25. [f2].Resize(dic.Count) = WorksheetFunction.Transpose(dic.keys) '输出主KEYS
    
26. [g2].Resize(dic.Count, UBound(kr) + 1) = WorksheetFunction.Transpose(WorksheetFunction.Transpose(kr))  '本语句报错，如何输出嵌套【子key】？
    
27. [I2].Resize(dic.Count, UBound(tr) + 1) = WorksheetFunction.Transpose(WorksheetFunction.Transpose(tr)) '本语句报错，如何输出嵌套【子item】？
    
28. End Sub

复制代码

autumnalRain

就这个例子讲，通过字典嵌套反而复杂些。目的在于通过这个例子学习下如何输出子key和子item？还请老师们指导！

autumnalRain

普通字典用法和结果的输出方式：

Sub DicTest1()

    Set dic = CreateObject("Scripting.Dictionary") 'use Dictionary
               
    For i = 1 To 3
        dic(i) = i * 10 '字典赋值
    Next
   
'输出方法-1： 传统方法、提取一维数组结果后转置输出
    [a1].Resize(dic.Count) = WorksheetFunction.Transpose(dic.Keys)
    [b1].Resize(dic.Count) = WorksheetFunction.Transpose(dic.items)
   

'输出方法-2： Array数组合并结果后转置输出   
    [a1].Resize(dic.Count, 2) = WorksheetFunction.Transpose(Array(dic.Keys, dic.items))

   
'下面是详细分解过程：
    kr = dic.Keys '提取keys
    tr = dic.items '提取items
    t1 = Array(dic.Keys, dic.items) '合并
    t2 = WorksheetFunction.Transpose(t1) '转置

'上述过程可以合并为一句代码：
    t = WorksheetFunction.Transpose(Array(dic.Keys, dic.items))
   
End Sub

autumnalRain

字典Item项目的数组用法、以及结果的输出方式：

Sub DicTest2()

    Set dic = CreateObject("Scripting.Dictionary") 'use Dictionary
               
    For i = 1 To 5
        dic(i) = Array(i, i * 10, i * 100) '把数组作为Item项目写入字典
    Next
   
    [a1].CurrentRegion = ""
    [a1].Resize(dic.Count) = WorksheetFunction.Transpose(dic.Keys) 'Output keys result

'字典Items内容为数组时、需要二次转置后才能输出：
    [b1].Resize(dic.Count, 3) = Application.Transpose(Application.Transpose(dic.items))

'或者可以用这个Rept函数处理方法： 不需要转置。
    [b1].Resize(dic.Count, 3) = Application.Rept(dic.items, 1)   
   
End Sub

huang1314wei

每个人写代码的思路不一样，如果看你的代码，我觉得比较累，还是自己写比较好，代码如下：

1. Sub test()
   
2.     Dim arr, i%, d, rng As Range, c
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = Range("A1").CurrentRegion
   
5.     [e2:G1048576].ClearContents
   
6.     For i = 2 To UBound(arr)
   
7.         If Not d.exists(arr(i, 1)) Then Set d(arr(i, 1)) = CreateObject("scripting.dictionary")
   
8.         d(arr(i, 1))(arr(i, 2)) = d(arr(i, 1))(arr(i, 2)) + arr(i, 3)
   
9.     Next
   
10.     For Each c In d.keys
    
11.         Set rng = Range("F1048576").End(3).Offset(1)
    
12.         rng.Resize(d(c).Count, 2) = Application.Transpose(Array(d(c).keys, d(c).items))
    
13.         rng.Resize(d(c).Count, 1).Offset(0, -1) = c
    
14.     Next
    
15. End Sub

复制代码

autumnalRain

本贴是学习用，这个例子体现不出嵌套字典的优势！所以再次感谢各位老师，百忙之中的指导！

t13564865256

autumnalRain 发表于 2015-12-10 10:27
非常感谢t13564865256老师，百忙中帮助解答！
给出的答案如下：

1. Sub 字典嵌套()
   
2. 'On Error Resume Next
   
3. Dim dic As Object, i As Long, j As Long
   
4. Dim arrOut()
   
5. Dim arrOutNum As Long
   
6. Dim kr(), tr()
   
7. arr = Range([a2], [c2].End(xlDown))
   
8. Set dic = CreateObject("Scripting.Dictionary")
   
9. For i = 1 To UBound(arr) '设置字典嵌套
   
10.     Set dic(arr(i, 1)) = CreateObject("Scripting.Dictionary")
    
11. Next
    
12. krr = dic.keys
    
13. For i = 1 To UBound(arr)
    
14.      dic(arr(i, 1))(arr(i, 2)) = dic(arr(i, 1))(arr(i, 2)) + arr(i, 3)
    
15. Next
    
16. arrOutNum = 0
    
17. Erase arrOut
    
18. For i = 0 To dic.Count - 1
    
19.     kr = dic(krr(i)).keys
    
20.     tr = dic(krr(i)).items
    
21.     For j = 0 To UBound(kr)
    
22.         arrOutNum = arrOutNum + 1
    
23.         ReDim Preserve arrOut(1 To 3, 1 To arrOutNum)
    
24.         arrOut(1, arrOutNum) = krr(i)
    
25.         arrOut(2, arrOutNum) = kr(j)
    
26.         arrOut(3, arrOutNum) = tr(j)
    
27.     Next j
    
28. Next
    
29. [e2].Resize(arrOutNum, UBound(arrOut)) = WorksheetFunction.Transpose(arrOut) '输出
    
30. End Sub

复制代码

autumnalRain

huang1314wei 发表于 2015-12-10 10:23
每个人写代码的思路不一样，如果看你的代码，我觉得比较累，还是自己写比较好，代码如下：

十分感谢您的指导！学习……

autumnalRain

这个例子也可以参考
http://club.excelhome.net/thread-1013232-1-1.html
这个用法儿

yeminqiang

字典嵌套看得难以理解，不过既然有大神说其中看不中用，那就不再想了。留名顶帖。