vba 字典统计求教

ykcbf1100

练习一下。

1. Sub ykcbf()  '//2024.6.16
   
2.     Dim arr, brr, d, s
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     ReDim brr(1 To 100000, 1 To 100)
   
7.     m = 1: n = 3
   
8.     With Sheets("Sheet1")
   
9.         r = .Cells(Rows.Count, 1).End(3).Row
   
10.         arr = .[a1].Resize(r, 6)
    
11.         brr(1, 1) = arr(1, 2)
    
12.         brr(1, 2) = arr(1, 3)
    
13.         brr(1, 3) = arr(1, 4)
    
14.         For i = 2 To UBound(arr)
    
15.             If arr(i, 4) <> 4 Then
    
16.                 If arr(i, 1) <> Empty Then
    
17.                     s = arr(i, 2) & "|" & arr(i, 3) & "|" & arr(i, 4)
    
18.                     If Not d.exists(s) Then
    
19.                         m = m + 1
    
20.                         d(s) = m
    
21.                         brr(m, 1) = arr(i, 2)
    
22.                         brr(m, 2) = arr(i, 3)
    
23.                         brr(m, 3) = arr(i, 4)
    
24.                     End If
    
25.                     r = d(arr(i, 2) & "|" & arr(i, 3) & "|" & arr(i, 4))
    
26.                     s = arr(i, 5)
    
27.                     If Not d.exists(s) Then
    
28.                         n = n + 1
    
29.                         d(s) = n
    
30.                         brr(1, n) = "产品等级" & s
    
31.                     End If
    
32.                     c = d(arr(i, 5))
    
33.                     brr(r, c) = brr(r, c) + arr(i, 6)
    
34.                 End If
    
35.             End If
    
36.         Next
    
37.     End With
    
38.     With Sheets("结果")
    
39.         .UsedRange.Clear
    
40.         .[a1].Resize(m, n) = brr
    
41.         .[a1].Resize(1, n).Interior.Color = 49407
    
42.         ActiveWindow.DisplayZeros = False
    
43.         Set Rng = .[a1].Resize(m, n)
    
44.         With Rng
    
45.             .Borders.LineStyle = 1
    
46.             .HorizontalAlignment = xlCenter
    
47.             .VerticalAlignment = xlCenter
    
48.             .EntireColumn.AutoFit
    
49.             With .Font
    
50.                 .Name = "微软雅黑"
    
51.                 .Size = 11
    
52.             End With
    
53.         End With
    
54.     End With
    
55.     Set d = Nothing
    
56.     Application.ScreenUpdating = True
    
57.     MsgBox "OK！"
    
58. End Sub
    
59. 
    

复制代码

65861954

quqiyuan 发表于 2024-6-14 23:12
参与一下，供参考。。。

老师的代码太简洁明了，特别是match一个集合确定列数，第一次遇见这种写法，让我茅塞顿开。谢谢老师！

wang-way

taller 发表于 2024-6-15 05:55

版主  分组部分是不是写错了  group by 生产厂, 生产班组, 产品等级

wang-way

练个手

wang-way

JSA 练个手

wang-way

sdytsxd991122 发表于 2024-6-16 10:38

牛啊 真是够精简的

LIUZHU

参与下，效果

LIUZHU

JS代码，参考16楼写的

LIUZHU

附件，WPS打开测试，点击按钮

LIUZHU

wang-way 发表于 2024-6-17 00:51
JSA 练个手

我以前也喜欢这么用，数据装到字典里面，在转换成数组输出，现在数组当字典用