VBA如何分组求和在原表插入合计行

脚毛乱了

如图根据B列类型分组，然后合计销量和销售额，在原表插入合计行或者把合计行都放在最后也行

xiangbaoan

参考.zip (21.13 KB, 下载次数: 24)

2022-8-13 11:24 上传

点击文件名下载附件

iwoego

xiangbaoan 发表于 2022-8-13 11:24

v = ar(i, x): ar(i, x) = ar(y, x): ar(y, x) = v 大佬，这句话是什么意思啊？

LIUZHU

WPSJS宏，请参考

LIUZHU

附件在此，请测试，用WPS打开

准提部林

原表操作//
Sub TEST_A1()
Dim xR As Range, xH As Range, T$, i&, R&, s1, s2
Application.ScreenUpdating = False
R = Cells(Rows.Count, 1).End(3).Row
With Range("a1:e" & R)
     .Sort Key1:=.Item(2), Order1:=xlAscending, Header:=xlYes
     For i = R To 2 Step -1
         Set xR = .Cells(i, 1)
         If xR(1, 2) <> T Then
            T = xR(1, 2): s1 = 0: s2 = 0
            .Rows(i).Copy
            xR(2).Insert Shift:=xlDown
            Set xH = xR(2)
         End If
         s1 = s1 + xR(1, 4): s2 = s2 + xR(1, 5)
         If xR(0, 2) <> T Then
            With xH.Resize(1, 5)
                 .Value = Array("合計", T, "", s1, s2)
                 .Font.Bold = True
            End With
         End If
     Next i
End With
Application.CutCopyMode = False
End Sub

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr, crr(), drr()
   
4.   Dim d As Object
   
5.   Set d = CreateObject("scripting.dictionary")
   
6.   With Worksheets("sheet1")
   
7.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
8.     arr = .Range("a2:e" & r)
   
9.     For i = 1 To UBound(arr)
   
10.       If Not d.exists(arr(i, 2)) Then
    
11.         m = 1
    
12.         ReDim brr(1 To m)
    
13.       Else
    
14.         brr = d(arr(i, 2))
    
15.         m = UBound(brr) + 1
    
16.         ReDim Preserve brr(1 To m)
    
17.       End If
    
18.       brr(m) = i
    
19.       d(arr(i, 2)) = brr
    
20.     Next
    
21.     ReDim crr(1 To UBound(arr) + d.Count, 1 To UBound(arr, 2))
    
22.     m = 0
    
23.     For Each aa In d.keys
    
24.       brr = d(aa)
    
25.       ReDim drr(1 To UBound(arr, 2))
    
26.       For i = 1 To UBound(brr)
    
27.         m = m + 1
    
28.         For j = 1 To UBound(arr, 2)
    
29.           crr(m, j) = arr(brr(i), j)
    
30.         Next
    
31.         For j = 4 To 5
    
32.           drr(j) = drr(j) + arr(brr(i), j)
    
33.         Next
    
34.       Next
    
35.       m = m + 1
    
36.       crr(m, 1) = "合计"
    
37.       For j = 4 To 5
    
38.         crr(m, j) = drr(j)
    
39.       Next
    
40.     Next
    
41.     .Range("p2").Resize(UBound(crr), UBound(crr, 2)) = crr
    
42.   End With
    
43. End Sub
    

复制代码

chxw68

参与一下。

feilanga

1. Sub 添加合计行()
   
2.     Sheet1.Range("P2:T" & Rows.Count).ClearContents  '清空结果输出区
   
3.     Sheet1.Range("P2:T" & Rows.Count).Borders.LineStyle = xlNone
   
4.     arr = Sheet1.Range("a1").CurrentRegion
   
5.     Set dic = CreateObject("scripting.dictionary")
   
6.     Set dic销量和值 = CreateObject("scripting.dictionary")
   
7.     Set dic销售额和值 = CreateObject("scripting.dictionary")
   
8.     For i = 2 To UBound(arr)
   
9.         Key = arr(i, 2)
   
10.         dic(Key) = dic(Key) & "," & i
    
11.         dic销量和值(Key) = dic销量和值(Key) + arr(i, 4)
    
12.         dic销售额和值(Key) = dic销售额和值(Key) + arr(i, 5)
    
13.     Next
    
14.     keys = dic.keys
    
15.     items = dic.items
    
16.     ReDim brr(1 To 10000, 1 To 5)
    
17.     For i = 0 To dic.Count - 1
    
18.         temp1 = Right(items(i), Len(items(i)) - 1) '取string右段x个字符组成的字符串
    
19.         temp = Split(temp1, ",")
    
20.         For j = 0 To UBound(temp)
    
21.             k = k + 1
    
22.             行号 = temp(j)
    
23.             brr(k, 1) = arr(行号, 1) '名称
    
24.             brr(k, 2) = dic.keys()(i) '类型
    
25.             brr(k, 3) = arr(行号, 3) '价格
    
26.             brr(k, 4) = arr(行号, 4) '销量
    
27.             brr(k, 5) = arr(行号, 5) '销售额
    
28.         Next
    
29.         k = k + 1
    
30.         brr(k, 1) = "合计:"
    
31.         brr(k, 2) = dic.keys()(i)
    
32.         brr(k, 4) = dic销量和值.items()(i)
    
33.         brr(k, 5) = dic销售额和值.items()(i)
    
34.     Next
    
35.     Sheet1.Range("P2").Resize(k, 5) = brr
    
36.     Sheet1.Range("P2").Resize(k, 5).Borders.LineStyle = 1
    
37. End Sub
    
38. 
    

复制代码

feilanga

原表插入合计行