利用VBA实现Excel电子表格自动分页统计

1、利用VBA实现Excel电子表格（工资报表）自动分页统计作者：王志华摘要：利用VBA编程，在Excel中启用宏命令，实现工资报表自动分页统计，方便工资统计和查找报表错误，减少统计误差，提高工作效率。关键词：VBA Excel 工资报表 分页统计一、问题的提出:随着Excel制作的电子报表越来越多，应用越来越广泛，常常遇到对其项目进行分页统计的问题，尤其是在工资报表系统中，在手动对工资项目进行分页统计时，如果出现人员增加、减少或人员调动产生的变换位置的情况，就得对动辄几十、上百页的报表重新对每页手动设置公式进行分页合计，再最后汇总，给报表的制作带来极大不便，增加了很大的工作量，降低了工作效率。如

2、果利用Microsoft Visual Basic Project即VBA编辑宏命令，对报表进行自动分页、每页自动合计和最后总合计，将大大地减少工作强度，提高统计工作的效率和准确性。二、问题的解决（功能的实现）:1、打开Excel电子表格应用软件。2、点击Excel窗口菜单，从下拉菜单中点击取消隐藏菜单项，弹出对话框如图：3、然后点击确定，Excel自动切换到Microsoft Excel PERSONAL编辑中，如图所示：4、点击Excel菜单栏里的工具菜单，点面下来菜单里的宏选项里的录制宏命令弹出录制新宏对话框，如图所示：5、点击保存在的下来箭头，选择个人宏工作簿，然后点击确认，开始录制事

3、先编辑好的自动分页汇总和删除分页统计的宏。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 ' 小计区域第一个单

4、元格 Public Sub 自动分页汇总() Cells(1, 1).Select On Error Resume Next t = 2Do i = InputBox("默认为10，不能超过一页的范围！ ", "请输入每页拟打印的行数", 10)If i <= 0 Or i = "" Then MsgBox ("每页行数必须大于1！")Else Exit DoEnd IfLoop i = Int(i) h = InputBox("起始行数，默认为5 ", "请输入起始行数&quo

5、t;, 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

6、.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, colu

7、mncount).Formula = "=SUM(R-" + CStr(i) + "C:R-1C)" 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),

8、 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.Sel

9、ectedSheets.HPageBreaks.Add Before:=Rows(x + 2) '在当前工作表中Rows(x + 2)行插入分隔符 x = (i + 1) * t x = x + h - 1 t = t + 1 l = l + 1Loop 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 -

10、 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-1C)" With ActiveSheet.Range(Cells(l + 1, 1), Cells(l + 1, Selection.Columns.Count).Borders &

11、#39;边框设置 .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

12、 + 1, 1), Cells(x + 1, Selection.Columns.Count).Interior '设置单元格底色 '.ColorIndex = 8 '为青色 End WithNext columncountCase h hh = 1Case 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

13、 + 1, lleft - 1).Merge '合并单元格 Cells(l + 1, 1) = "本页合计" Cells(l + 1, columncount).Formula = "=SUM(R-" + CStr(rrr) + "C:R-1C)" With ActiveSheet.Range(Cells(l + 1, 1), Cells(l + 1, Selection.Columns.Count).Borders '边框设置 .Line = xlBorderLine .Weight = xlMedium '

14、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).Interi

15、or '设置单元格底色 ' .ColorIndex = 8 '为青色 End WithNext columncountEnd Select Rows(l + hh).Insert Shift:=xlDownFor columncount = lleft To Selection.Columns.Count - lright ' 循环选择的每一列。 Range(Cells(l + hh, 1), Cells(l + hh, lleft - 1).Merge '合并单元格 Cells(l + hh, 1) = "总合计" Cells(l

16、+ hh, columncount).Formula = "=SUM(R-" + CStr(l - h + 1) + "C:R-1C)/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

17、 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

18、Next columncount Range(Cells(1, 1), Cells(l + 1, 2).Locked = True ActiveSheet.Protect Cells(1, 1).Select End SubPublic Sub 删除分页汇总() On Error Resume Next ActiveSheet.Unprotect Cells.Locked = False ActiveSheet.ResetAllPageBreaks lastline = a65536.End(xlUp).Row Set r1stSubCell = Range("Ah") &

19、#39; 本例名单从 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 rCurrentCellEnd Sub10、关闭宏编辑模板，退到Excel电子表格应用软件中。11、在Excel菜单栏框内点击右键，弹出对话框如图：11、在弹出一个对话框点击自定义，弹出一个新对话框如图：12、在自定义对话框中选择命令标签，并点击新菜单选项，将新菜单拖入Excel菜单栏中新建菜单，并改名为我的菜单。13、然后再在自定义对话框中选择命令标签，并点击宏选项，将自定义菜单项拖入Excel