字典嵌套2

yshcy

在学嵌套字典。数据源在AB列，要求的结果是DE列。代码没有问题。k = d.items这句是加上去的，目的是为了按F8看运行结果。K=d.items的结果就是我们想要的.。brr(i, 1) = d.keys()(i - 1)的结果是 A列不重复值1、2、3、4。  brr(i, 2) = Join(d(d.keys()(i - 1)).keys)提取了B列的相对于A列1、2、3、4所分别对应的不重复值。d(arr(i, 1))(arr(i, 2)) =""，说明嵌套字典的items为空。所以，只能是取嵌套字典的KEY.。但是为什么K=d.items得出我们想要的结果呢？这点理解不了，请老师指教，谢谢。

蓝桥玄霜

你这里的k就是第2级字典的关键字。
一般可以这样写：

1. Sub test()
   
2. Dim d, arr(), brr(), k, t
   
3. [d2:e50].ClearContents
   
4. Set d = CreateObject("scripting.dictionary")
   
5. arr = Range("a1").CurrentRegion
   
6. For i = 2 To UBound(arr)
   
7.     If Not d.exists(arr(i, 1)) Then
   
8.         Set d(arr(i, 1)) = CreateObject("scripting.dictionary")
   
9.     End If
   
10.     d(arr(i, 1))(arr(i, 2)) = ""
    
11.    
    
12. Next i
    
13. ReDim brr(1 To d.Count, 1 To 2)
    
14. k = d.keys: t = d.items
    
15. For i = 1 To d.Count
    
16.     brr(i, 1) = k(i - 1)
    
17.     brr(i, 2) = Join(t(i - 1).keys)
    
18. Next i
    
19. [d2].Resize(d.Count, 2) = brr
    
20. End Sub
    

复制代码

ww87725244

关键就是字典嵌套这句啊，字典的item可以是任何数字、字符、容器
set d(arr(i,1))=createobject("scripting.dictionary")
举例：d(arr(i, 1))(arr(i, 2)) = ""
当arr(i,1)=1时，字典d的key:1，item：d(1)-------就是一个字典
那么d(1)的key就是"甲",item为空

yshcy

ww87725244 发表于 2024-9-8 15:22
关键就是字典嵌套这句啊，字典的item可以是任何数字、字符、容器
set d(arr(i,1))=createobject("scriptin ...

就是不理解，既然设定了d(arr(i, 1))(arr(i, 2)) = ""，items为空，为什么k=d.items的结果，按F8会出来结果昵。 是不是 这样理解：d(arr(i,1))(arr(i,2))中，d(arr(i,2)相当于字典的key.   d(arr(i,1))是一个字典的名字，不要当作key,也不要当作item

yshcy

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

就是看您以前写的精华贴。能否发一个关于字典嵌套的精华贴子呢？，谢谢

lizhipei78

yshcy 发表于 2024-9-8 16:33
就是看您以前写的精华贴。能否发一个关于字典嵌套的精华贴子呢？，谢谢

https://club.excelhome.net/thread-1672918-1-1.html
看我这个

yshcy

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

就我这次提的问题，如果E列的结果，不是放在E列的同一个单元格，而是要从E列开始，放到FGHI等各列，在此代码的基础上，要如何改进，谢谢

ynzsvt

见横放模块。在你自己的代码上修改的。

Qs18

1. Sub qs()
   
2. Dim arr, i, dic As Object, rw
   
3. rw = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
   
4. arr = Sheet1.Range("a1").Resize(rw, 2).Value
   
5. Set dic = CreateObject("scripting.dictionary")
   
6. For i = 2 To UBound(arr)
   
7.     s = arr(i, 1): s2 = arr(i, 2)
   
8.     If Not dic.exists(s) Then Set dic(s) = CreateObject("scripting.dictionary")
   
9.     dic(s)(s2) = ""
   
10. Next
    
11. ReDim brr(1 To dic.Count, 1 To 2)
    
12. For Each k In dic.keys
    
13.     m = m + 1
    
14.     brr(m, 1) = k
    
15.     t = ""
    
16.     For Each ii In dic(k).keys
    
17.         t = t & " " & ii
    
18.     Next
    
19.     brr(m, 2) = Mid(t, 2)
    
20. Next
    
21. Sheet1.Range("d2").Resize(m, 2) = brr
    
22. End Sub

复制代码

Qs18

试试。。。。。。。