Question to say "I can!"

EXCEL自動分頁小計

2012-09-10

許多朋友都有這樣的難題。就是一個EXCEL表,有N多頁,內容都是連續的,但卻需要在每一頁上加一個小計。

一般情況下,需要手工在每一頁的下方加一行小計,但這樣既浪費時間,又不方便以后的工作。

從網上搜索到這段代碼,可以輕松的實現分頁小計。在此,也謝謝寫這段代碼的兄弟/姐妹,雖然不知是哪位大俠。

使用方面:打開EXCEL,打開VBA編輯器,把這段代碼復制進去。然后在EXCEL上添加一個按鈕,指定宏即可。

代碼:

Sub 分頁小計()
If ActiveSheet.ProtectContents Then MsgBox "工作表已保護,本程序拒絕執行!", 64, "提示": Exit Sub
Dim columm As Integer, colunn As Integer, A_row As Long, T, I As Integer, J As Byte
columm = Application.InputBox("請輸入需要匯總之首列數," & Chr(10) & "將從該列開始產生小計及累計和。" & Chr(10) & "如果你只需要匯總一列,請在匯總末列處輸入同樣數字即可。", "匯總首列", 3, , , , , 1)
colunn = Application.InputBox("請輸入需要匯總之末列數," & Chr(10) & "將從首列至此列之間的單元格產生小計及累計和。", "匯總末列", 5, , , , , 1)
If columm = False Or colunn = False Then GoTo err
If 3 = False Or columm = False Or 5 = False Or colunn = False Then GoTo err
T = 2
If ExecuteExcel4Macro("Get.Document(50)") > 1 Then
I = Application.ExecuteExcel4Macro("INDEX(GET.DOCUMENT(64),1)") - 5
Else
MsgBox "對不起,您的文件不足一頁,此功能無效。", vbOKOnly + 64, "提示"
Exit Sub
End If
Application.ScreenUpdating = False
X = I + 2
A_row = Range("A65536").End(xlUp).Row
Do While A_row >= X
Rows(X).Insert Shift:=xlDown
Rows(X).Insert Shift:=xlDown
Cells(X, 1) = "本頁小計"
Cells(X + 1, 1) = "累??? 計"
For J = columm To colunn
Cells(X, J).Formula = "=SUM(R[-" + CStr(I) + "]C:R[-1]C)"
Cells(X + 1, J) = "=SUM(R[-" + CStr(I + 2) + "]C:R[-2]C)"
Next J
ActiveWindow.SelectedSheets.HPageBreaks.Add before:=Rows(X + 2)
X = (I + 2) * T
T = T + 1
A_row = A_row + 2
Loop
A_row = Range("A65536").End(xlUp).Row
Range("iv65536").FormulaArray = "=MAX((R[-65535]C[-255]:R[-1]C[-255]=""累??? 計"")*ROW(R[-65535]:R[-1]))"
For J = columm To colunn
Cells(A_row + 1, J).FormulaR1C1 = "=SUM(R[-" + CStr(A_row - Range("iv65536").Value) + "]C:R[-1]C)"
Cells(A_row + 2, J).FormulaR1C1 = "=SUM(R[-" + CStr(A_row - Range("iv65536") + 2) + "]C:R[-2]C)"
Next J
Cells(A_row + 1, 1) = "本頁小計"
Cells(A_row + 2, 1) = "累??? 計"
Range("IV65536").Delete
Range(Cells(A_row + 1, 1), Cells(A_row + 2, ActiveSheet.UsedRange.Columns.Count)).Borders.LineStyle = xlContinuous
Range([b2], Cells(2, ActiveSheet.UsedRange.Columns.Count)).EntireColumn.AutoFit
Columns("A:A").HorizontalAlignment = xlLeft
Cells(1, 1).Select
Application.ScreenUpdating = True
Exit Sub
err:
MsgBox "對不起,您未指定求和列,程序即將退出。", vbOKOnly + 64, "提示"
End Sub

 

也可以使用Excel百寶箱:http://www.skycn.com/soft/56679.html

或者查找:Excel自動分頁小計匯總工具

其實這個方法也還不是我想要的,我想要的是小計和最后的合計在打印或預覽的時候才出現。

作者:admin | Categories:軟件使用 | Tags:

3條評論

  1. admin說道:

    金山表格快速插入分頁小計的方法:
    http://school.cfan.com.cn/office/wps/2006-10-31/1162287750d21392.shtml

  2. admin說道:

    vba 打印自動每頁小計 最后一頁合計:

    方法一:
    Dim i%, Ps%, YJtext, mm$
    Sub 方法一打印()
    mm = MsgBox("是否已經手動設置過 頁面設置!" & vbCrLf & " 如果已經設置,點是" _
    & vbCrLf & " 如果已經沒有,點否", _
    vbQuestion + vbYesNo, "小爪提示")
    If 呵呵 = vbNo Then
    Exit Sub
    End If
    Ps = ExecuteExcel4Macro("GET.DOCUMENT(50)") '總頁數
    MsgBox "現在打印開始."
    For i = 1 To Ps
    Call 方法一指定頁腳
    ActiveSheet.PrintOut from:=i, To:=i
    Next i
    MsgBox "現在打印結束."
    End Sub
    Sub 方法一指定頁腳()
    If i = Ps Then
    YJtext = i
    BBB = "本頁小計: " & Sheets("小計頁").Range("A" & YJtext) & "元" & " 本單合計: " & Sheets("小計頁").Range("B" & YJtext)
    Else
    YJtext = i
    BBB = "本頁小計 " & Sheets("小計頁").Range("A" & YJtext) & "元"
    End If
    ActiveSheet.PageSetup.CenterFooter = BBB '定義頁腳
    End Sub

    方法二:
    Dim i%, Ps%, mm$, H, P1
    Sub 方法二打印()
    mm = MsgBox("是否已經手動設置過 頁面設置!" & vbCrLf & " 如果已經設置,點是" _
    & vbCrLf & " 如果已經沒有,點否", _
    vbQuestion + vbYesNo, "小爪提示")
    If 呵呵 = vbNo Then
    Exit Sub
    End If
    Ps = ExecuteExcel4Macro("GET.DOCUMENT(50)") '總頁數
    MsgBox "現在打印開始."
    For i = 1 To Ps
    H = ActiveSheet.HPageBreaks(i).Location.Row - 1
    Call 方法二指定頁腳
    ActiveSheet.PrintOut from:=i, To:=i
    Next i
    MsgBox "現在打印結束."
    ActiveSheet.Range("a1").Select
    End Sub
    Sub 方法二指定頁腳()
    If i = 1 Then
    BBB = "本頁小計: " & Application.WorksheetFunction.Sum(Range(Cells(1, 2), Cells(H, 2))) & "元"
    ElseIf i = Ps Then
    BBB = "本頁小計: " & Application.WorksheetFunction.Sum(Range(Cells(P1, 2), Cells(H, 2))) & "元" _
    & " 本單合計: " & Application.WorksheetFunction.Sum(Range(Cells(1, 2), Cells(H, 2))) & "元"
    Else
    BBB = "本頁小計: " & Application.WorksheetFunction.Sum(Range(Cells(P1, 2), Cells(H, 2))) & "元"
    End If
    P1 = H + 1
    ActiveSheet.PageSetup.CenterFooter = BBB '定義頁腳
    ActiveWindow.ScrollRow = H / i * (i + 1) ‘沒有這句不行
    End Sub

發表評論

電子郵件地址不會被公開。 必填項已用*標注

*

澳洲f1赛车b盘开奖套路 云南十一选五五开奖结果300期 甘肃快3开奖查询 腾讯一分彩开奖记录 吉林11选5遗漏号 福建快3开今日开奖号码表 彩票网 体彩吉林11选5怎么玩 基金配资比例两种模式 天津体彩11选五技巧 福建快三昨天没出的号码 众诚速配 天津11选5走势图 佳永配资手机版 今日股票大盘 25选5历史开奖百度文库 山东群英会计划软件