如何在每页自动增加个本页小计？

陈王宇翔

行数不固定。有的行高宽有的窄。

陈王宇翔

看来是不好解决了

yaozong

陈王宇翔 发表于 2018-5-8 20:42
看来是不好解决了

论坛有类似例子，查询一下。

魂断蓝桥

Sub a()
Dim arr, i%, S, M%, T
arr = [a1].CurrentRegion
For i = 4 To UBound(arr)
    If arr(i, 1) <> "本页小计" Then
        S = "G" & i
    Else
        M = M + 1
            If M = 1 Then
                Cells(i, "G") = "=SUM(G4:" & S & ")"
                Cells(i, "G").Resize(1, 11) = "=SUM(G4:" & S & ")"
                Cells(i, "L").Resize(1, 5) = ""
                T = "G" & i + 1
            Else
                Cells(i, "G") = "=SUM(" & T & ":G" & i - 1 & ")"
                Cells(i, "G").Resize(1, 11) = "=SUM(" & T & ":G" & i - 1 & ")"
                Cells(i, "L").Resize(1, 5) = ""
                T = "G" & i + 1
            End If
    End If
Next
End Sub

ggmmlol

1. Sub 清除小计()
   
2. Excel.Application.ScreenUpdating = False
   
3. With Range("A1").CurrentRegion
   
4.     .Offset(3).EntireRow.AutoFit
   
5.     arr = .Value
   
6.     For i = .Rows.Count To 4 Step -1
   
7.         If arr(i, 1) = "本页小计" Then .Rows(i).Delete
   
8.     Next
   
9. End With
   
10. End Sub
    
11. 
    
12. Sub 添加小计()
    
13. Call 清除小计
    
14. Const 小计行高 = 13.5
    
15. oldRowHeight = Rows(3).RowHeight
    
16. Rows(3).RowHeight = oldRowHeight + 小计行高
    
17. Dim id()
    
18. Dim hb As HPageBreak
    
19. ReDim id(0 To Me.HPageBreaks.Count + 1)
    
20. id(0) = 4
    
21. For Each hb In Me.HPageBreaks
    
22.     n = n + 1
    
23.     id(n) = hb.Location.Row
    
24. Next
    
25. For i = n To 1 Step -1
    
26.     re = id(i)
    
27.     rs = re - id(i - 1)
    
28.     If rs <= 0 Then Exit For
    
29.     Rows(re).Insert
    
30.     Range("A" & re) = "本页小计"
    
31.     Range("A" & re).Interior.Color = vbYellow
    
32.     Range("A" & re).Resize(1, 2).Merge
    
33.     Rows(re).RowHeight = 小计行高
    
34.     Range("J1:k1,Q1:R1").Offset(re - 1).FormulaR1C1 = "=SUBTOTAL(109,R[-" & rs & "]C:R[-1]C)"
    
35. Next
    
36. Rows(3).RowHeight = oldRowHeight
    
37. End Sub

复制代码

云海拾贝

ggmmlol 发表于 2018-5-11 11:35

ReDim id(0 To Me.HPageBreaks.Count + 1) 数据成员找不到

ggmmlol

云海拾贝 发表于 2018-5-11 15:49
ReDim id(0 To Me.HPageBreaks.Count + 1) 数据成员找不到

把所有代码粘贴到相应的工作表模块下，

或者

把 "Me." 替换 "ActiveSheet."

lytznh

For Each hb In ActiveSheet.HPageBreaks

运行时错误9 下标越界

yaozong

Sub 添加小计()
Call 清除小计
Const 小计行高 = 13.5
oldRowHeight = Rows(3).RowHeight
Rows(3).RowHeight = oldRowHeight + 小计行高
Dim id(), r&
Dim hb As HPageBreak
ReDim id(0 To ActiveSheet.HPageBreaks.Count + 1)
id(0) = 4
r = Cells(Rows.Count, 1).End(3).Row + 1
ActiveSheet.HPageBreaks.Add Before:=Cells(r, 1)
ActiveWindow.View = xlPageBreakPreview
For Each hb In ActiveSheet.HPageBreaks
    n = n + 1
    id(n) = hb.Location.Row
Next
For i = n To 1 Step -1
    re = id(i)
    rs = re - id(i - 1)
    If rs <= 0 Then Exit For
    Rows(re).Insert
    Range("A" & re) = "本页小计"
    Range("A" & re).Interior.Color = vbYellow
    Range("A" & re).Resize(1, 2).Merge
    Rows(re).RowHeight = 小计行高
    Range("J1:k1,Q1:R1").Offset(re - 1).FormulaR1C1 = "=SUBTOTAL(109,R[-" & rs & "]C:R[-1]C)"
Next
Rows(3).RowHeight = oldRowHeight
ActiveWindow.View = xlNormalView
End Sub[/code][/code]

陈王宇翔

yaozong 发表于 2018-5-11 17:25
Sub 添加小计()
Call 清除小计
Const 小计行高 = 13.5

1. 
   
2. Sub 添加小计()
   
3. Const 小计行高 = 13.5
   
4. oldRowHeight = Rows(3).RowHeight
   
5. Rows(3).RowHeight = oldRowHeight + 小计行高
   
6. Dim id(), r&
   
7. Dim hb As HPageBreak
   
8. ReDim id(0 To ActiveSheet.HPageBreaks.Count + 1)
   
9. id(0) = 4
   
10. r = Cells(Rows.Count, 1).End(3).Row + 1
    
11. ActiveSheet.HPageBreaks.Add Before:=Cells(r, 1)
    
12. ActiveWindow.View = xlPageBreakPreview
    
13. For Each hb In ActiveSheet.HPageBreaks
    
14.     n = n + 1
    
15.     id(n) = hb.Location.Row
    
16. Next
    
17. For i = n To 1 Step -1
    
18.     re = id(i)
    
19.     rs = re - id(i - 1)
    
20.     If rs <= 0 Then Exit For
    
21.     Rows(re).Insert
    
22.     Range("A" & re) = "本页小计"
    
23.     Range("A" & re).Interior.Color = vbYellow
    
24.     Range("A" & re).Resize(1, 2).Merge
    
25.     Rows(re).RowHeight = 小计行高
    
26.     Range("J1:k1,Q1:R1").Offset(re - 1).FormulaR1C1 = "=SUBTOTAL(109,R[-" & rs & "]C:R[-1]C)"
    
27. Next
    
28. Rows(3).RowHeight = oldRowHeight
    
29. ActiveWindow.View = xlNormalView
    
30. End Sub

复制代码