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

发表评论

电子邮件地址不会被公开。 必填项已用*标注

*

无觅相关文章插件,快速提升流量