利用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