比较难的数据统计

szdcp

         大神您好！比较复杂的数据统计请您帮忙，附件中数据源的数据按类别汇总填充到统计工作表，因数据量较大近一万行，人为统计效率非常低，请大神们看看能不能用VBA实现自动统计，为方便大神理解，附件2行示例中不良程度和不良类别数据统计的方法使用公式计算，这样可能明确知道统计数据的区域，不良类别数据无规律，汇总比较难，希望大神能帮忙，先谢谢了

grf1973

请看附件。

ykcbf1100

不是很明白啊，要排重汇总吗？如果排重汇总的话，那检查时间也要汇总吗？

szdcp

grf1973 发表于 2023-2-8 15:53
请看附件。

感谢大神帮忙，程序添加了注释非常适合我学习，超赞

szdcp

ykcbf1100 发表于 2023-2-8 15:57
不是很明白啊，要排重汇总吗？如果排重汇总的话，那检查时间也要汇总吗？

按行汇总，所以检查时间不汇总

chxw68

1. Sub test()
   
2.     Dim r&, i&
   
3.     Dim arr, brr
   
4.     Application.ScreenUpdating = False
   
5.     Application.DisplayAlerts = False
   
6.     With Worksheets("数据源")
   
7.         .AutoFilterMode = False
   
8.         r = .Cells(.Rows.Count, 2).End(xlUp).Row
   
9.         c = .Cells(1, .Columns.Count).End(xlToLeft).Column
   
10.         arr = .Range("a2").Resize(r - 1, c)
    
11.     End With
    
12.     ReDim brr(1 To UBound(arr), 1 To 23)
    
13.     For i = 1 To UBound(arr)
    
14.         For j = 2 To 12
    
15.             brr(i, j - 1) = arr(i, j)
    
16.         Next
    
17.         For j = 15 To 69 Step 6
    
18.             For k = 1 To 5
    
19.                 brr(i, k + 12) = brr(i, k + 12) + arr(i, j + k)
    
20.                 brr(i, 12) = brr(i, 12) + arr(i, j + k)
    
21.             Next
    
22.             x = 0
    
23.             Select Case arr(i, j)
    
24.                 Case "外观"
    
25.                     x = 18
    
26.                 Case "组装"
    
27.                     x = 19
    
28.                 Case "包装"
    
29.                     x = 20
    
30.                 Case "机能"
    
31.                     x = 21
    
32.             End Select
    
33.             If x > 0 Then
    
34.                 For k = 1 To 5
    
35.                     brr(i, x) = brr(i, x) + arr(i, j + k)
    
36.                 Next
    
37.             End If
    
38.             brr(i, 22) = arr(i, 13)
    
39.             brr(i, 23) = arr(i, 14)
    
40.         Next
    
41.     Next
    
42.     With Worksheets("统计")
    
43.         .UsedRange.Offset(2, 0).Clear
    
44.         .Columns(2).NumberFormatLocal = "@"
    
45.         .Columns(23).NumberFormatLocal = "0.00"
    
46.         With .Range("a3").Resize(UBound(brr), UBound(brr, 2))
    
47.             .Value = brr
    
48.             .Borders.LineStyle = xlContinuous
    
49.             With .Font
    
50.                 .Name = "微软雅黑"
    
51.                 .Size = 11
    
52.             End With
    
53.         End With
    
54.     End With
    
55. End Sub
    

复制代码

chxw68

详见附件。

ykcbf1100

grf1973 发表于 2023-2-8 15:53
请看附件。

解题方法巧妙，但结果用9行是根据如何来的？我感觉是漏数据了，我看了下，10和11行也有数据的。

szdcp

chxw68 发表于 2023-2-8 16:08
详见附件。

感谢帮忙！

grf1973

ykcbf1100 发表于 2023-2-8 16:13
解题方法巧妙，但结果用9行是根据如何来的？我感觉是漏数据了，我看了下，10和11行也有数据的。

调试时用的。。。。改为ubound(brr）