字典嵌套小白入门笔记

月关

一把小刀闯天下 发表于 2019-10-9 10:44
一般用字典数组，很少用字典嵌套

E列工作簿、D列工作表。先有序不用字典估计也能解决，，，

多谢老师。
解法有很多，只是单纯的学习字典嵌套而已。

月关

ykqrs 发表于 2019-10-9 11:14
好久没来，今天进坛子正好碰到这个贴，本想练练手，呵呵，手生了，好一个找帖子抄，终于炒出来了，费这么大 ...

忍不住，有点忍不住，请先原谅学生的鄙俗。。。
看了您发上来的代码，有种感觉。。。。感觉就是。。。。一个人在拉屎，屎头子都快掉地上了，又给他硬塞回去，然后再用手拽出来……… 这就是最后加那个brr数组给我的感觉，抱歉抱歉，请无视我的浅薄…… ……

zopey

月关 发表于 2019-10-9 11:41
虽然有点跑偏，但是老师的这个用法还是第一次见，好像挺不错，有啥名头没？类似于字典、正则这样的，回头 ...

姑且称为，字典嵌套集合

月关

1#最后的代码有几句没有意义，根据11#老师的指正删改如下：

Sub 字典套字典基础入门案例()
Dim d As Object, area, school, id, person, age, s, n&
arr = [a1].CurrentRegion
Set d = CreateObject("scripting.dictionary")
For i = 2 To UBound(arr)
area = arr(i, 5): school = arr(i, 4): id = arr(i, 1): person = arr(i, 2): age = arr(i, 3)
    If Not d.exists(area) Then Set d(area) = CreateObject("scripting.dictionary")
    If Not d(area).exists(school) Then Set d(area)(school) = CreateObject("scripting.dictionary")
    d(area)(school)(id) = Array(person, age)
Next

s = Array("地区", "高校", "学号", "姓名", "年龄")
Application.ScreenUpdating = False
For Each area In d.keys
    Workbooks.Add
    With ActiveWorkbook
        For Each school In d(area)
            .Worksheets.Add.Name = school: n = 0
            For Each id In d(area)(school)
                n = n + 1
                Cells(1, 1).Resize(, 5) = s
                Cells(n + 1, 1) = area
                Cells(n + 1, 2) = school
                Cells(n + 1, 3) = id
                Cells(n + 1, 4).Resize(, 2) = d(area)(school)(id)
            Next
        Next
    .SaveAs ThisWorkbook.Path & "\" & area & ".xlsx"
    .Close True
    End With
Next
Application.ScreenUpdating = True
End Sub

ykqrs

月关 发表于 2019-10-9 11:47
忍不住，有点忍不住，请先原谅学生的鄙俗。。。
看了您发上来的代码，有种感觉。。。。感觉就是。。。。 ...

那就直接COPY

1. Sub 字典套字典基础入门案例()
   
2. Dim d As Object, arr, i%, aa, bb
   
3. arr = [a1].CurrentRegion
   
4. Set d = CreateObject("scripting.dictionary")
   
5. For i = 2 To UBound(arr)
   
6. If Not d.exists(arr(i, 5)) Then Set d(arr(i, 5)) = CreateObject("scripting.dictionary")
   
7. If Not d(arr(i, 5)).exists(arr(i, 4)) Then Set d(arr(i, 5))(arr(i, 4)) = Cells(1, 1).Resize(1, 5)
   
8. Set d(arr(i, 5))(arr(i, 4)) = Union(d(arr(i, 5))(arr(i, 4)), Cells(i, 1).Resize(1, 5))
   
9. Next
   
10. Application.ScreenUpdating = False
    
11. Application.DisplayAlerts = False
    
12. For Each aa In d.keys
    
13. Workbooks.Add
    
14. With ActiveWorkbook
    
15. For Each bb In d(aa).keys
    
16. .Worksheets.Add.Name = bb
    
17. With .Worksheets(bb)
    
18. d(aa)(bb).Copy .Range("a1")
    
19. End With
    
20. Next
    
21. .SaveAs ThisWorkbook.Path & "" & aa & ".xlsx"
    
22. .Close True
    
23. End With
    
24. Next
    
25. Application.ScreenUpdating = True
    
26. Application.DisplayAlerts = True
    
27. End Sub
    
28. 
    

复制代码

ykqrs

月关 发表于 2019-10-9 11:57
1#最后的代码有几句没有意义，根据11#老师的指正删改如下：

Sub 字典套字典基础入门案例()

有时间可以多模拟些数据，看看你这个直接操作单元格的运行速度和我那一个你有点忍不住的哪个快？

小花鹿

字典嵌套不好玩，变通方法多的是，我只重视结果正确，不看效率                                                

micch

1. Sub test()
   
2.     arr = [a1].CurrentRegion
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     For i = 2 To UBound(arr)
   
5.         If Not d.exists(arr(i, 5)) Then Set d(arr(i, 5)) = CreateObject("scripting.dictionary")
   
6.         If Not d(arr(i, 5)).exists(arr(i, 4)) Then Set d(arr(i, 5))(arr(i, 4)) = CreateObject("scripting.dictionary")
   
7.         d(arr(i, 5))(arr(i, 4))(i) = Array(arr(i, 1), arr(i, 2), arr(i, 3))
   
8.     Next
   
9.     n = 1
   
10.     For Each x In d.keys
    
11.         Cells(n, 8) = x
    
12.         For Each y In d(x).keys
    
13.             Cells(n, 9) = y
    
14.             Cells(n, 10).Resize(d(x)(y).Count, 3) = Application.Transpose(Application.Transpose(d(x)(y).items))
    
15.             n = Cells(65536, 10).End(3).Row + 1
    
16.         Next
    
17.         n = Cells(65536, 10).End(3).Row + 1
    
18.     Next
    
19. End Sub
    

复制代码

学习学习，嵌套一下。不想建新文件，直接输出到表中吧，把学生的3个信息作为item，直接输出字典的items就行

月关

ykqrs 发表于 2019-10-9 13:49
有时间可以多模拟些数据，看看你这个直接操作单元格的运行速度和我那一个你有点忍不住的哪个快？

听出老师见怪来了。。。。
但其实这题不关解法，不关效率。
仅仅是我想学习字典嵌套不得其门而入，偶然一天看到一个求助贴然后豁然贯通。

那个帖子被删了，但我觉得用来理解学习字典嵌套很好，所以把它还原出来，用来给和我当初一样卡住的人参悟。

micch

add工作表学习

Sub test()
    arr = [a1].CurrentRegion
    ar = [a1:c1]
    Set d = CreateObject("scripting.dictionary")
    For i = 2 To UBound(arr)
        If Not d.exists(arr(i, 5)) Then Set d(arr(i, 5)) = CreateObject("scripting.dictionary")
        If Not d(arr(i, 5)).exists(arr(i, 4)) Then Set d(arr(i, 5))(arr(i, 4)) = CreateObject("scripting.dictionary")
        d(arr(i, 5))(arr(i, 4))(i) = Array(arr(i, 1), arr(i, 2), arr(i, 3))
    Next
    For Each x In d.keys
        For Each y In d(x).keys
            Worksheets.Add.Name = y
            Worksheets(y).[a1:c1] = ar
            Worksheets(y).[a2].Resize(d(x)(y).Count, 3) = Application.Transpose(Application.Transpose(d(x)(y).items))
        Next
    Next
End Sub