利用VBA实现Excel电子表格自动分页统计
利用VBA实现Excel电子表格（工资报表）自动分页统计
作者：王志华
摘要：利用VBA编程，在Excel中启用宏命令，实现工资报表自动分页统计，方便工资统计和查找报表错误，减少统计误差，提高工作效率。
关键词：VBA Excel 工资报表分页统计
一、问题的提出:
随着Excel制作的电子报表越来越多，应用越来越广泛，常常遇到对其项目进行分页统计的问题，尤其是在工资报表系统中，在手动对工资项目进行分页统计时，如果出现人员增加、减少或人员调动产生的变换位置的情况，就得对动辄几十、上百页的报表重新对每页手动设置公式进行分页合计，再最后汇总，给报表的制作带来极大不便，增加了很大的工作量，降低了工作效率。如果利用Microsoft Visual Basic Project即VBA编辑宏命令，对报表进行自动分页、每页自动合计和最后总合计，将大大地减少工作强度，提高统计工作的效率和准确性。
二、问题的解决（功能的实现）:
1、打开Excel电子表格应用软件。
2、点击Excel窗口菜单，从下拉菜单中点击取消隐藏菜单项，弹出对话框如图：
3、然后点击确定，Excel自动切换到Microsoft Excel – PERSONAL编辑中，如图所示：
4、点击Excel菜单栏里的工具菜单，点面下来菜单里的宏选项里的录制宏命令弹出录制新宏对话框，如图所示：
5、点击保存在的下来箭头，选择个人宏工作簿，然后点击确认，开始录制事先编辑好的自动分页汇总和删除分页统计的宏。
6、按Alt+F8键，弹出启动宏命令对话框，如图所示：
7、点击新建宏命令对话框中的编辑按钮，弹出如下对话框：
8、在模块中输入或编辑、调试事先编辑好的宏命令，如图所示：
9、具体自动分页汇总和、删除分页汇总宏命令如下：
Dim i, h, hh, t, l, x, rr, dr, tt, ls, cs, lleft, lright As Integer
Dim rrr As String
Dim rCurrentCell As Range ' 每一页之分页小计所在单元格
Dim r1stSubCell As Range ' 小计区域第一个单元格
Public Sub 自动分页汇总()
Cells(1, 1).Select
On Error Resume Next
t = 2
Do
i = InputBox("默认为10，不能超过一页的范围！！！", "请输入每页拟打印的行数", 10)
If i <= 0 Or i = "" Then
MsgBox ("每页行数必须大于1！")
Else
Exit Do
End If
Loop
i = Int(i)
h = InputBox("起始行数，默认为5 ", "请输入起始行数", 5)
x = i + h
lleft = InputBox("起始列数，默认为2列", "请输入起始列", 2)
lright = InputBox("最终列数，默认为倒数第0列", "请输入最终列", 0)
l = Range("A65536").End(xlUp).Row '本示例选定包含单元格B4 的区域中 B 列顶端的单元格。Range("B4").End(xlUp).Select
'For RowCount = 1 To Selection.Rows.Count '循环选择的每一行。
Do While l >= x
Rows(x + 1).Insert Shift:=xlDown '在当前工作表中Rows(x + 1)行插入空隔行
For columncount = lleft To Selection.Columns.Count - lright ' 循环选择的每一列。
Range(Cells(x + 1, 1), Cells(x + 1, lleft - 1)).Merge '合并单元格
Cells(x + 1, 1) = "本页合计"
Cells(x + 1, columncount).Formula = "=SUM(R[-" + CStr(i) + "]C:R[-1]C)"
With ActiveSheet.Range(Cells(x + 1, 1), Cells(x + 1, Selection.Columns.Count)).Borders '边框设置
.Line = xlBorderLine
.Weight = xlMedium 'xlThin 细线'xlThick粗线
.ColorIndex = 3
End With
With ActiveSheet.Range(Cells(x + 1, 1), Cells(x + 1,
Selection.Columns.Count)).Font '字体设置
'.Size = 14
.Bold = True
'.Italic = True
.ColorIndex = 3
End With
With ActiveSheet.Range(Cells(x + 1, 1), Cells(x + 1, Selection.Columns.Count)).Interior '设置单元格底色
'.ColorIndex = 8 '为青色
End With
Next columncount
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Rows(x + 2) '在当前工作表中Rows(x + 2)行插入分隔符x = (i + 1) * t
x = x + h - 1
t = t + 1
l = l + 1
Loop
rr = l Mod (i + 1)
Rows(l + 1).Insert Shift:=xlDown
Select Case rr
Case h + 1 To i
hh = 2
rr = rr - h
rrr = CStr((rr))
For columncount = lleft To Selection.Columns.Count - lright ' 循环选择的每一列。
Range(Cells(l + 1, 1), Cells(l + 1, lleft - 1)).Merge '合并单元格
Cells(l + 1, 1) = "本页合计"
Cells(l + 1, columncount).Formula = "=SUM(R[-" + CStr(rrr) + "]C:R[-1]C)"
With ActiveSheet.Range(Cells(l + 1, 1), Cells(l + 1, Selection.Columns.Count)).Borders '边框设置
.Line = xlBorderLine
.Weight = xlMedium 'xlThin 细线'xlThick粗线
.ColorIndex = 3
End With
With ActiveSheet.Range(Cells(l + 1, 1), Cells(l + 1, Selection.Columns.Count)).Font '字体设置
'.Size = 14
.Bold = True
'.Italic = True
.ColorIndex = 3
End With
With ActiveSheet.Range(Cells(x + 1, 1), Cells(x + 1, Selection.Columns.Count)).Interior '设置单元格底色
'.ColorIndex = 8 '为青色
End With
Next columncount
Case h
hh = 1
Case 0 To h - 1
hh = 2
rr = rr + i - h + 1
rrr = CStr((rr))
For columncount = lleft To
Selection.Columns.Count - lright ' 循环选择的每一列。
Range(Cells(l + 1, 1), Cells(l + 1, lleft - 1)).Merge '合并单元格
Cells(l + 1, 1) = "本页合计"
Cells(l + 1, columncount).Formula = "=SUM(R[-" + CStr(rrr) + "]C:R[-1]C)"
With ActiveSheet.Range(Cells(l + 1, 1), Cells(l + 1, Selection.Columns.Count)).Borders '边框设置
.Line = xlBorderLine
.Weight = xlMedium 'xlThin 细线'xlThick粗线
.ColorIndex = 3
End With
With ActiveSheet.Range(Cells(l + 1, 1), Cells(l + 1, Selection.Columns.Count)).Font '字体设置
'.Size = 14
.Bold = True
'.Italic = True
.ColorIndex = 3
End With
With ActiveSheet.Range(Cells(x + 1, 1), Cells(x + 1, Selection.Columns.Count)).Interior '设置单元格底色
' .ColorIndex = 8 '为青色
End With
Next columncount
End Select
Rows(l + hh).Insert Shift:=xlDown
For columncount = lleft To Selection.Columns.Count - lright ' 循环选择的每一列。
Range(Cells(l + hh, 1), Cells(l + hh, lleft - 1)).Merge
'合并单元格
Cells(l + hh, 1) = "总合计"
Cells(l + hh, columncount).Formula = "=SUM(R[-" + CStr(l - h + 1) + "]C:R[-1]C)/2"
With ActiveSheet.Range(Cells(l + hh, 1), Cells(l + hh, Selection.Columns.Count)).Borders '边框设置
.Line = xlBorderLine
.Weight = xlMedium 'xlThin 细线'xlThick粗线
.ColorIndex = 3 '3红色、4绿色
End With
With ActiveSheet.Range(Cells(l + hh, 1), Cells(l + hh, Selection.Columns.Count)).Font '字体设置
'.Size = 14
.Bold = True
'.Italic = True
.ColorIndex = 3
End With
With ActiveSheet.Range(Cells(l + hh, 1), Cells(l + hh, Selection.Columns.Count)).Interior '设置单元格底色
.ColorIndex = 8 '为青色
End With
Next columncount
Range(Cells(1, 1), Cells(l + 1, 2)).Locked = True
ActiveSheet.Protect
Cells(1, 1).Select
End Sub
Public Sub 删除分页汇总()
On Error Resume Next
ActiveSheet.Unprotect
Cells.Locked = False
ActiveSheet.ResetAllPageBreaks
lastline = [a65536].End(xlUp).Row
Set r1stSubCell = Range("Ah") ' 本例名单从Ah 单元格开始
For Each rCurrentCell In Range(r1stSubCell, r1stSubCell.End(xlDown))
For i = lastline To h Step -1
If Range("A" & i) = "本页合计" Or Range("A" & i) = "总合计" Then Range(i & ":" & i).EntireRow.Delete
Next i
Next rCurrentCell
End Sub
10、关闭宏编辑模板，退到Excel电子表格应用软件中。
11、在Excel菜单栏框内点击右键，弹出对话框如图：
11、在弹出一个对话框点击自定义，弹出一个新对话框如图：
12、在自定义对话框中选择命令标签，并点击新菜单选项，将新菜单拖入Excel菜单栏中新建菜单，并改名为我的菜单。
13、然后再在自定义对话框中选择命令标签，并点击宏选项，将自定义菜单项拖入Excel菜单栏中我的菜单下，新建弹出式菜单，并改名为自动分页统计和删除分页统计如图：
14、然后点击指定宏，弹出对话框如图：
15、在弹出的对话框中分别为我的菜单中的自动分页汇总和删除分页汇总指定相应的宏命令。
16、然后点击Excel菜单栏中的窗口菜单中的隐藏命令，把Microsoft Excel – PERSONAL页面隐藏。
17、到此为止，用VBA实现Excel电子表格的自动分页
汇总就编辑完毕。
三、举例验证效果（功能的验证）:
1、调入任意一张Excel工资表，如图所示:
2、点击Excel菜单栏中我的菜单，在弹出的下来菜单中，点击自动分页汇总，弹出如下对话框：
3、输入需要每页打印的行数，默认输入为10行，点击确定弹出如下对话框：
4、输入需要统计工资表的起始行数，即表头行数，默认为3行，点击确定弹出如下对话框：
5、输入需要统计工资表的起始列数，默认为5列，点击确定弹出如下对话框：
6、输入需要统计工资表的最终列数，默认为倒数第2列，点击确定，即完成自动分页汇总，结果下对话框：
7、如果删除分页统计，则点击Excel菜单栏中我的菜单，在弹出的下拉菜单中，点击删除分页汇总菜单，则删除原来统计项，恢复为原来的表格内容，如下图所示：
8、可以重新进行任意行的分页统计，例如非整页统计结果如下所示：
9、功能演示完毕，功能得到认定。
此宏命令能将其他Excel电子报表进行类似的按要求分页、每页自动合计和最后总合计，避免了手动完成这部分工作的繁琐，降低了工作强度，提高了工作效率，如果是长达几十、上百页的报表，更能表现其效果了。