字典嵌套2

Qs18

试试。。。。。。。。。。。

sero61

蓝桥玄霜 发表于 2024-9-8 15:08
你这里的k就是第2级字典的关键字。
一般可以这样写：

感谢老师指点 学习一下字典嵌套

yshcy

lizhipei78 发表于 2024-9-8 16:50
https://club.excelhome.net/thread-1672918-1-1.html
看我这个

在你这个贴子下提了一个问题，请指教，谢谢。为了便于理解，我把i改成从10到15。a=d(10).keys,b=d(10).items.但结果，a 和b都是1-9。b是items.这个可以理解。为什么a是keys，也是1-9呢？

lizhipei78

yshcy 发表于 2024-9-15 16:18
在你这个贴子下提了一个问题，请指教，谢谢。为了便于理解，我把i改成从10到15。a=d(10).keys,b=d(10).it ...

你还不是理解嵌套啊，这里面d(10)是一个字典，它的key 是1-9(for j=1 to 9),item也是1—9
即是第一个Key是d(10) (1)，以此类推

ykcbf1100

练个手，一个字典

ykcbf1100

练手。。。。

1. Sub ykcbf()   '//2024.9.16
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     With Sheets("Sheet1")
   
4.         r = .Cells(Rows.Count, 1).End(3).Row
   
5.         arr = .[a1].Resize(r, 2)
   
6.         ReDim brr(1 To r, 1 To 2)
   
7.         For i = 2 To UBound(arr)
   
8.             s = arr(i, 1)
   
9.             If Not d.exists(s) Then
   
10.                 m = m + 1
    
11.                 d(s) = m
    
12.                 brr(m, 1) = s
    
13.                 brr(m, 2) = arr(i, 2)
    
14.             Else
    
15.                 r = d(s)
    
16.                 brr(r, 2) = brr(r, 2) & "，" & arr(i, 2)
    
17.             End If
    
18.         Next
    
19.         .[d2].Resize(r, 2) = ""
    
20.         .[d2].Resize(m, 2) = brr
    
21.     End With
    
22.     Set d = Nothing
    
23.     MsgBox "OK！"
    
24. End Sub
    

复制代码

ykcbf1100

继续练手，2个字典

ykcbf1100

二个字典

1. Sub ykcbf2()   '//2024.9.16
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     With Sheets("Sheet1")
   
4.         r = .Cells(Rows.Count, 1).End(3).Row
   
5.         arr = .[a1].Resize(r, 2)
   
6.         For i = 2 To UBound(arr)
   
7.             s = arr(i, 1): ss = arr(i, 2)
   
8.             If Not d.exists(s) Then Set d(s) = CreateObject("Scripting.Dictionary")
   
9.             d(s)(ss) = ""
   
10.         Next
    
11.         ReDim brr(1 To d.Count, 1 To 2)
    
12.         For Each k In d.keys
    
13.             m = m + 1
    
14.             brr(m, 1) = k
    
15.             brr(m, 2) = Join(d(k).keys, "，")
    
16.         Next
    
17.         .[d2].Resize(r, 2) = ""
    
18.         .[d2].Resize(m, 2) = brr
    
19.     End With
    
20.     Set d = Nothing
    
21.     MsgBox "OK！"
    
22. End Sub
    

复制代码