EXCEL自动分页小计的VBA宏代码

EXCEL自动分页小计的VBA宏代码

 

许多朋友都有这样的难题。就是一个EXCEL表，有N多页，内容都是连续的，但却需要在每一页上加一个小计。

一般情况下，需要手工在每一页的下方加一行小计，但这样既浪费时间，又不方便以后的工作。

从网上搜索到这段代码，可以轻松的实现分页小计。在此，也谢谢写这段代码的兄弟/姐妹，虽然不知是哪位大侠。

 

使用方面：打开EXCEL，打开VBA编辑器，把这段代码复制进去。然后在EXCEL上添加一个按钮，指定宏即可。

 

代码：

Dim rCurrentCell As Range   ' 每一页之分页小计所在单元格
Dim r1stSubCell As Range    ' 小计区域第一个单元格

Sub 删除原有的分页小计行()
    Set r1stSubCell = Range("A5")           ' 本例名单从 A5 单元格开始
    For Each rCurrentCell In Range(r1stSubCell, r1stSubCell.End(xlDown))
        If rCurrentCell = "小计" Then rCurrentCell.EntireRow.Delete
    Next
End Sub

Sub 新建分页小计()
    Dim iSubCol As Integer, rSubArea As Range
    Dim hb As HPageBreak

    ActiveWindow.View = xlPageBreakPreview  ' 进入 分页浏览 模式, 以便 EXCEL 正确计页
    Set r1stSubCell = Range("A5")           ' 本例名单从 A5 单元格开始
    iSubCol = 20                            ' 本例小计项共有 20 列

    ' 避免可能的错误:手工分页符正好与自动分页符重合
    ' 建议运行前先删除手工分页符
    ' 本过程可选
    'For Each hb In ActiveSheet.HPageBreaks
    '    On Error Resume Next
    '    If hb.Type = xlPageBreakManual Then hb.Delete
    'Next

    ' 最后一行插入手工分页符
    ActiveSheet.HPageBreaks.Add Before:=r1stSubCell.End(xlDown).Offset(1, 0)

    ' 测试每一个分页符,
    ' 如果是自动分页符, 则在其上一行插入一小计行, 而本行纳入下一页
    ' 否则, 在本行插入一小计行
    For Each hb In ActiveSheet.HPageBreaks
        Set rCurrentCell = hb.Location
        rCurrentCell.Select                 ' 看看先

        If hb.Type = xlPageBreakAutomatic Then Set rCurrentCell = rCurrentCell.Offset(-1, 0)

        rCurrentCell.EntireRow.Insert
        Set rCurrentCell = rCurrentCell.Offset(-1, 0)

        ' 添加分页小计内容
        With rCurrentCell
            .Value = "小计"
            .Font.Bold = True

            Set rSubArea = .Offset(0, 1).Resize(1, iSubCol) ' 需要填充分页小计公式的区域
           
            ' 使用 SUBTOTAL 公式的好处是方便扩展, 且不会对已计算区域重复计算(如果可能发生这种情况的话)
            rSubArea.Formula = "=SUBTOTAL(9," & r1stSubCell.Offset(0, 1).Address(1, 0) & ":" & .Offset(-1, 1).Address(1, 0) & ")"

            Set r1stSubCell = .Offset(1, 0)
        End With
    Next

    ActiveWindow.View = xlNormalView
End Sub