Excel技巧—实现分页小计与合计实现分页小计与合计：可以采用函数法、VBA等等，下面提供VBA的一种实现方法。 分页小计（采用VBA） 1、建立模块：m分页小计1 代码 Dim rCurrentCell As Range ' 每一页之分页小计所在单元格 Public ll(50) Dim r1stSubCell As Range ' 小计区域第一个单元格 ' ------------------------------------------------- ' 从这里开始执行 Sub Main() t = Timer Application.ScreenUpdating = False Worksheets("sheet1").Activate 删除分页符 Set r1stSubCell = Range("A5") ' 本例名单从 A5 单元格开始 For Each rCurrentCell In Range(r1stSubCell, r1stSubCell.End(xlDown)) If rCurrentCell = "本页小计" Or rCurrentCell = "总 计" Then rCurrentCell.EntireRow.Delete Next Set r1stSubCell = Range("A5") ' 本例名单从 A5 单元格开始 For Each rCurrentCell In Range(r1stSubCell, r1stSubCell.End(xlDown)) If rCurrentCell = "本页小计" Or rCurrentCell = "总 计" Then rCurrentCell.EntireRow.Delete Next 新建分页小计 Range("A5").Activate ' MsgBox "分页小计已完成!" & Chr(13) & "共用时间" & Round(Timer - t, 2) & "秒" Application.ScreenUpdating = True End Sub ' ------------------------------------------------- Sub 删除原有的分页小计行() Application.ScreenUpdating = False Set r1stSubCell = Range("A5") ' 本例名单从 A5 单元格开始 For Each rCurrentCell In Range(r1stSubCell, r1stSubCell.End(xlDown)) If rCurrentCell = "本页小计" Or rCurrentCell = "总 计" Then rCurrentCell.EntireRow.Delete Next Set r1stSubCell = Range("A5") ' 本例名单从 A5 单元格开始 For Each rCurrentCell In Range(r1stSubCell, r1stSubCell.End(xlDown)) If rCurrentCell = "本页小计" Or rCurrentCell = "总 计" Then rCurrentCell.EntireRow.Delete Next Range("A1").Activate MsgBox "已成功删除分页小计" Application.ScreenUpdating = True End Sub Sub 新建分页小计() Application.ScreenUpdating = False t = UserForm1.TextBox1.Value & "," l = Len(t) t1 = "" 'Dim ll(50) Unload UserForm1 P = 1 For n = 1 To l w = Application.WorksheetFunction.Find(",", t, n) ll(P) = Mid(t, n, w - n) If IsNumeric(Val(ll(P))) = False Or Val(ll(P)) < 2 Then MsgBox "输入错误,请重新输入" GoTo AAA End If P = P + 1 n = w If n >= l Then Exit For Next Dim iSubCol As Integer, rSubArea As Range Dim hb As HPageBreak Worksheets("sheet1").Activate Rows(Range("a65536").End(xlUp).Row).Copy Range("a" & Range("a65536").End(xlUp).Row + 1) Rows(Range("a65536").End(xlUp).Row).ClearContents Range("a" & Range("a65536").End(xlUp).Row + 1) = " " ActiveWindow.View = xlPageBreakPreview ' 进入 分页浏览 模式, 以便 EXCEL 正确计页 Set r1stSubCell = Range("A5") ' 本例名单从 A5 单元格开始 iSubCol = 9 ' 本例小计项共有 20 列
' 最后一行插入手工分页符 ActiveSheet.HPageBreaks.Add Before:=r1stSubCell.End(xlDown).Offset(1, 0) ActiveSheet.HPageBreaks.Add Before:=Range("a65536").End(xlUp) ' 测试每一个分页符, ' 如果是自动分页符, 则在其上一行插入一小计行, 而本行纳入下一页 ' 否则, 在本行插入一小计行 For Each hb In ActiveSheet.HPageBreaks Set rCurrentCell = hb.Location rCurrentCell.Select ' 看看先 If hb.Type = xlPageBreakAutomatic Then Set rCurrentCell = rCurrentCell.Offset(-1, 0) rCurrentCell.EntireRow.Insert Set rCurrentCell = rCurrentCell.Offset(-1, 0) ' 添加分页小计内容 With rCurrentCell .Value = "本页小计" .Font.Bold = True 'Set rSubArea = Application.Union(Range("d" & rCurrentCell.Row), Range("u" & rCurrentCell.Row)) ' 需要填充分页小计公式的区域 ' Set rSubArea = Range("b" & rCurrentCell.Row, "T" & rCurrentCell.Row) ' 需要填充分页小计公式的区域 ' 使用 SUBTOTAL 公式的好处是方便扩展, 且不会对已计算区域重复计算(如果可能发生这种情况的话) ' rSubArea.Formula = "=SUBTOTAL(9," & r1stSubCell.Offset(0, 1).Address(1, 0) & ":" & .Offset(-1, 1).Address(1, 0) & ")" For yy = 1 To P - 1 .Offset(0, ll(yy) - 1).Formula = "=SUBTOTAL(9," & r1stSubCell.Offset(0, ll(yy) - 1).Address(1, 0) & ":" & .Offset(-1, ll(yy) - 1).Address(1, 0) & ")" Next
Set r1stSubCell = .Offset(1, 0) End With Next Rows(Range("a65536").End(xlUp).Row).Clear If Range("A65536").End(xlUp) = " " Then Rows(Range("a65536").End(xlUp).Row).Clear Rows(Range("a65536").End(xlUp).Row).Copy Range("a" & Range("a65536").End(xlUp).Row + 1) Rows(Range("a65536").End(xlUp).Row).ClearContents With Range("A" & Range("A65536").End(xlUp).Row + 1) .Value = "总 计" .Font.Bold = True For yy = 1 To P - 1 .Offset(0, ll(yy) - 1).Formula = "=SUBTOTAL(9," & Cells(5, ll(yy) - 0).Address & ":" & .Offset(-1, ll(yy) - 1).Address & ")" Next End With ' Set rSubArea = Range("b" & Range("A65536").End(xlUp).Row, "T" & Range("A65536").End(xlUp).Row) ' rSubArea.Offset(0, 0) = "=SUBTOTAL(9," & "B5:B" & Range("A65536").End(xlUp).Row - 1 & ")" 删除分页符 ActiveWindow.View = xlNormalView End AAA: UserForm1.Show End Sub Sub 删除分页符() On Error Resume Next t = ActiveSheet.HPageBreaks.Count For n = t To 1 Step -1 If ActiveSheet.HPageBreaks(n).Extent = xlPageBreakFull Then ActiveSheet.HPageBreaks(n).Delete End If t = ActiveSheet.HPageBreaks.Count Next End Sub 2、建立模块：模块1 代码 Public P Sub a() UserForm1.Show End Sub 3、建立窗体：UserForm1 并在窗体上建立TextBox1控件 窗体代码 Private Sub CommandButton1_Click() Main End Sub
| 
发表于 2010-6-23 21:45:22