VBA 字典 数组运用

kdsea

半百 发表于 2024-7-5 22:18
请测试

这个思路太好了，代码也少，感谢！

kdsea

shiruiqiang 发表于 2024-7-3 21:14
字典嵌套

多谢 ，代码学习中，有些抽象，不太好理解。

ykcbf1100

参与一下，2级字典

ykcbf1100

2级字典，表格转换

1. Sub ykcbf()   '//2024.7.7   表格转换,2级字典
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     bt = 2: col = 5
   
6.     With Sheets("Sheet1")
   
7.         r = .Cells(Rows.Count, col).End(3).Row
   
8.         arr = .[a1].Resize(r, 5)
   
9.     End With
   
10.     For i = bt + 1 To UBound(arr)
    
11.         s = arr(i, col)
    
12.         If Not d.exists(s) Then Set d(s) = CreateObject("Scripting.Dictionary")
    
13.         d(s)(i) = i
    
14.     Next
    
15.     ReDim brr(1 To 10000, 1 To 5)
    
16.     For Each k In d.keys
    
17.         n = 0: sum1 = 0: sum2 = 0
    
18.         For Each kk In d(k).keys
    
19.             n = n + 1
    
20.             m = m + 1
    
21.             brr(m, 1) = n
    
22.             brr(m, 2) = k
    
23.             brr(m, 3) = arr(kk, 2)
    
24.             brr(m, 4) = arr(kk, 3)
    
25.             brr(m, 5) = arr(kk, 4)
    
26.             sum1 = sum1 + Val(arr(kk, 3))
    
27.             sum2 = sum2 + Val(arr(kk, 4))
    
28.         Next
    
29.         s1 = s1 + sum1
    
30.         s2 = s2 + sum2
    
31.         m = m + 1
    
32.         brr(m, 1) = k & " " & "汇总"
    
33.         brr(m, 4) = sum1
    
34.         brr(m, 5) = sum2
    
35.     Next
    
36.     m = m + 1
    
37.     brr(m, 1) = "总计"
    
38.     brr(m, 4) = s1
    
39.     brr(m, 5) = s2
    
40.     With Sheets("Sheet2")
    
41.         .UsedRange.Offset(2).Clear
    
42.         With .[a3].Resize(m, 5)
    
43.             .Value = brr
    
44.             .Borders.LineStyle = 1
    
45.             .HorizontalAlignment = xlCenter
    
46.             .VerticalAlignment = xlCenter
    
47.         End With
    
48.         For i = 3 To m + 2
    
49.             If InStr(.Cells(i, 1), "汇总") Then
    
50.                 .Cells(i, 1).Resize(, 5).Interior.ColorIndex = 8
    
51.             End If
    
52.             If InStr(.Cells(i, 1), "总计") Then
    
53.                 .Cells(i, 1).Resize(, 5).Interior.ColorIndex = 6
    
54.             End If
    
55.         Next
    
56.     End With
    
57.     Set d = Nothing
    
58.     Application.ScreenUpdating = True
    
59.     Application.DisplayAlerts = True
    
60.     MsgBox "OK！"
    
61. End Sub
    

复制代码

jjmysjg

liuyu5863016 发表于 2024-7-3 23:22

F列于H列之间不能有数，太好了

今铭昔

kdsea

今铭昔 发表于 2024-7-8 08:08

谢谢 这个看不懂  是WPS宏代码

一招秒杀

1句4行，简单得不要不要的，漂亮得不像话，拉仇恨，没朋友

一招秒杀

ykcbf1100 发表于 2024-7-7 16:34
2级字典，表格转换

这么常见的数据处理，数据库几十年前就有标准解决办法，看上面的 只要 1句4行 ，简单吗？ 是不是一看就懂， 更不容易出错？随手1句彻底秒杀，把思想精力集中到现实的业务逻辑中去，而不是什么技术。世界多么美好。

ykcbf1100

一招秒杀 发表于 2024-7-8 10:45
这么常见的数据处理，数据库几十年前就有标准解决办法，看上面的 只要 1句4行 ，简单吗？ 是不是一看就懂 ...

你那一句4行代码，普通电脑上完成不了，没有你那个系统环境。