許多朋友都有這樣的難題。就是一個(gè)EXCEL表，有N多頁(yè)，內(nèi)容都是連續(xù)的，但卻需要在每一頁(yè)上加一個(gè)小計(jì)。

一般情況下，需要手工在每一頁(yè)的下方加一行小計(jì)，但這樣既浪費(fèi)時(shí)間，又不方便以后的工作。

從網(wǎng)上搜索到這段代碼，可以輕松的實(shí)現(xiàn)分頁(yè)小計(jì)。在此，也謝謝寫(xiě)這段代碼的兄弟/姐妹，雖然不知是哪位大俠。

 

使用方面：打開(kāi)EXCEL，打開(kāi)VBA編輯器，把這段代碼復(fù)制進(jìn)去。然后在EXCEL上添加一個(gè)按鈕，指定宏即可。

 

代碼：

Dim rCurrentCell As Range   ' 每一頁(yè)之分頁(yè)小計(jì)所在單元格
Dim r1stSubCell As Range    ' 小計(jì)區(qū)域第一個(gè)單元格

Sub 刪除原有的分頁(yè)小計(jì)行()
    Set r1stSubCell = Range("A5")           ' 本例名單從 A5 單元格開(kāi)始
    For Each rCurrentCell In Range(r1stSubCell, r1stSubCell.End(xlDown))
        If rCurrentCell = "小計(jì)" Then rCurrentCell.EntireRow.Delete
    Next
End Sub

Sub 新建分頁(yè)小計(jì)()
    Dim iSubCol As Integer, rSubArea As Range
    Dim hb As HPageBreak

    ActiveWindow.View = xlPageBreakPreview  ' 進(jìn)入 分頁(yè)瀏覽 模式, 以便 EXCEL 正確計(jì)頁(yè)
    Set r1stSubCell = Range("A5")           ' 本例名單從 A5 單元格開(kāi)始
    iSubCol = 20                            ' 本例小計(jì)項(xiàng)共有 20 列

    ' 避免可能的錯(cuò)誤:手工分頁(yè)符正好與自動(dòng)分頁(yè)符重合
    ' 建議運(yùn)行前先刪除手工分頁(yè)符
    ' 本過(guò)程可選
    'For Each hb In ActiveSheet.HPageBreaks
    '    On Error Resume Next
    '    If hb.Type = xlPageBreakManual Then hb.Delete
    'Next

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

    ' 測(cè)試每一個(gè)分頁(yè)符,
    ' 如果是自動(dòng)分頁(yè)符, 則在其上一行插入一小計(jì)行, 而本行納入下一頁(yè)
    ' 否則, 在本行插入一小計(jì)行
    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)

        ' 添加分頁(yè)小計(jì)內(nèi)容
        With rCurrentCell
            .Value = "小計(jì)"
            .Font.Bold = True

            Set rSubArea = .Offset(0, 1).Resize(1, iSubCol) ' 需要填充分頁(yè)小計(jì)公式的區(qū)域
           
            ' 使用 SUBTOTAL 公式的好處是方便擴(kuò)展, 且不會(huì)對(duì)已計(jì)算區(qū)域重復(fù)計(jì)算(如果可能發(fā)生這種情況的話)
            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