分页汇总求和及每页小计

ykcbf1100

VBA，按固定行数插入小计、插入累计

ykcbf1100

1. Sub ykcbf()   '//2025.4.8   插入小计、插入累计
   
2.     Application.ScreenUpdating = False
   
3.     bt = 3: col = 2: c = 12: rr = 24: c1 = 7
   
4.     xm = [{"每页小计","每页累计"}]
   
5.     With ActiveSheet
   
6.         If .FilterMode = True Then .ShowAllData     '//取消筛选状态
   
7.         r = .Cells(Rows.Count, 1).End(xlUp).Row
   
8.         m = r - bt
   
9.         If rr < 1 Then Exit Sub
   
10.         k = Application.Ceiling(m / rr, 1)
    
11.         For i = k To 1 Step -1
    
12.             r1 = bt + 1 + (i - 1) * rr
    
13.             r2 = Application.Min(r, bt + 1 + (i * rr - 1))
    
14.             m = r2 + 1
    
15.             .Rows(m & ":" & m + 1).Insert Shift:=xlDown
    
16.             .Cells(m, col).Value = xm(1)
    
17.             .Cells(m, 1).Resize(1, c).Interior.ColorIndex = 6
    
18.             .Cells(m, c1).Resize(, c - c1 + 1).Formula = "=SUM(" & Cells(r1, c1).Resize(r2 - r1 + 1).Address(1, 0) & ")"
    
19.             m = m + 1
    
20.             .Cells(m, col).Value = xm(2)
    
21.             .Cells(m, 1).Resize(1, c).Interior.ColorIndex = 4
    
22.             .Cells(m, c1).Resize(, c - c1 + 1).Formula = "=SUMIFS(" & Cells(bt + 1, c1).Resize(m - bt - 1).Address(1, 0) _
    
23.                 & "," & Cells(bt + 1, col).Resize(m - bt - 1).Address & "," & """" & xm(1) & """" & ")"
    
24.             .Cells(r2 + 1, 8).Resize(2) = "": .Cells(r2 + 1, 10).Resize(2) = ""
    
25.         Next i
    
26.         r = .Cells(Rows.Count, col).End(3).Row
    
27.         .[a1].Resize(r, c).Borders.LineStyle = 1
    
28.     End With
    
29.     Application.ScreenUpdating = True
    
30.     MsgBox "插入完成！共处理：" & k & " 段，插入行数：" & k * 2
    
31. End Sub
    

复制代码

wyslw2004

分类汇总功能也勉强可以，只是数据源需要排序了