求助分类汇总如何用代码完成

liqingwei123

wang-way 发表于 2024-6-20 12:54

感谢大哥帮忙，麻烦问下，数据源增加了新的省份数据的话就出错了，汇总的最下面一列数据是没有的，有办法解决吗

liqingwei123

grf1973 发表于 2024-6-20 14:03
。。。。。。。。。。。。

是我想要的，感谢大哥

wang-way

liqingwei123 发表于 2024-6-20 14:27
感谢大哥帮忙，麻烦问下，数据源增加了新的省份数据的话就出错了，汇总的最下面一列数据是没有的，有办法 ...

增加省份不会出错吧  没有写死的 最后一行 使用公式也行

ykcbf1100

除标题外，其它部分由代码自动产生。
附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.6.20
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Set d1 = CreateObject("Scripting.Dictionary")
   
5.     With Sheets("数据")
   
6.         r = .Cells(Rows.Count, 1).End(3).Row
   
7.         arr = .[a1].Resize(r, 15)
   
8.     End With
   
9.     ReDim brr(1 To 1000, 1 To 1)
   
10.     For i = 2 To UBound(arr)
    
11.         s = arr(i, 4)
    
12.         If Not d1.exists(s) Then
    
13.             m = m + 1
    
14.             d1(s) = m
    
15.             brr(m, 1) = s
    
16.         End If
    
17.         s = arr(i, 4) & "|" & arr(i, 8)
    
18.         If Not d.exists(s) Then
    
19.             d(s) = Array(1, arr(i, 14))
    
20.         Else
    
21.             t = d(s)
    
22.             t(0) = t(0) + 1
    
23.             t(1) = t(1) + arr(i, 14)
    
24.             d(s) = t
    
25.         End If
    
26.     Next
    
27.     With Sheets("结果")
    
28.         .UsedRange.Offset(2).Clear
    
29.         .[a3].Resize(m, 1) = brr
    
30.         bt = 2
    
31.         arr = .Range("a1:ab" & m + bt)
    
32.         On Error Resume Next
    
33.         For i = 3 To UBound(arr)
    
34.             sum1 = 0: sum2 = 0
    
35.             For j = 2 To UBound(arr, 2) - 3 Step 3
    
36.                 s = arr(i, 1) & "|" & arr(1, j)
    
37.                 If d.exists(s) Then
    
38.                     arr(i, j) = d(s)(0)
    
39.                     arr(i, j + 1) = d(s)(1)
    
40.                     arr(i, j + 2) = Application.WorksheetFunction.Round(arr(i, j + 1) / arr(i, j), 2)
    
41.                     sum1 = sum1 + arr(i, j)
    
42.                     sum2 = sum2 + arr(i, j + 1)
    
43.                 End If
    
44.             Next
    
45.             arr(i, UBound(arr, 2) - 2) = sum1
    
46.             arr(i, UBound(arr, 2) - 1) = sum2
    
47.             arr(i, UBound(arr, 2)) = Application.WorksheetFunction.Round(sum2 / sum1, 2)
    
48.         Next
    
49.         .Range("a1:ab" & m + bt) = arr
    
50.         .Cells(m + bt + 1, 1) = "合计"
    
51.         r = .Cells(Rows.Count, 1).End(3).Row
    
52.         For j = 2 To UBound(arr, 2) Step 3
    
53.             .Cells(r, j) = Application.Sum(.Cells(3, j).Resize(m))
    
54.             .Cells(r, j + 1) = Application.Sum(.Cells(3, j + 1).Resize(m))
    
55.             .Cells(r, j + 2) = Application.WorksheetFunction.Round(.Cells(r, j + 1) / .Cells(r, j), 2)
    
56.         Next
    
57.         With .Range("a1:ab" & m + bt + 1)
    
58.             .Borders.LineStyle = 1
    
59.             .HorizontalAlignment = xlCenter
    
60.             .VerticalAlignment = xlCenter
    
61.         End With
    
62.     End With
    
63.     Set d = Nothing
    
64.     Application.ScreenUpdating = True
    
65.     MsgBox "OK！"
    
66. End Sub
    

复制代码

liqingwei123

感谢楼上帮忙答复，在麻烦问下，如何对处理好的数据，例如0.5公斤段的平均值做降序且不影响汇总在最下面