2024年2月24日发(作者：)
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 '循环选择的每一行。
Do While l >= x
Rows(x + 1).Insert Shift:=xlDown '在当前工作表中Rows(x + 1)行插入空隔行
For columncount = lleft To - 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 (Cells(x + 1, 1), Cells(x + 1, )).Borders '边框设置
.Line = xlBorderLine
.Weight = xlMedium 'xlThin 细线'xlThick粗线
.ColorIndex = 3
End With
With (Cells(x + 1, 1), Cells(x + 1, )).Font '字体设置
'.Size = 14
.Bold = True
'.Italic = True
.ColorIndex = 3
End With
With (Cells(x + 1, 1), Cells(x + 1, )).Interior '设置单元格底色
'.ColorIndex = 8 '为青色
End With
Next columncount
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 - 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 (Cells(l + 1, 1), Cells(l + 1, )).Borders '边框设置
.Line = xlBorderLine
.Weight = xlMedium 'xlThin 细线'xlThick粗线
.ColorIndex = 3
End With
With (Cells(l + 1, 1), Cells(l + 1, )).Font '字体设置
'.Size = 14
.Bold = True
'.Italic = True
.ColorIndex = 3
End With
With (Cells(x + 1, 1), Cells(x + 1, )).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 - 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 (Cells(l + 1, 1), Cells(l + 1, )).Borders '边框设置
.Line = xlBorderLine
.Weight = xlMedium 'xlThin 细线'xlThick粗线
.ColorIndex = 3
End With
With (Cells(l + 1, 1), Cells(l + 1, )).Font '字体设置
'.Size = 14
.Bold = True
'.Italic = True
.ColorIndex = 3
End With
With (Cells(x + 1, 1), Cells(x + 1, )).Interior '设置单元格底色
' .ColorIndex = 8 '为青色
End With
Next columncount
End Select
Rows(l + hh).Insert Shift:=xlDown
For columncount = lleft To - 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 (Cells(l + hh, 1), Cells(l + hh, )).Borders '边框设置
.Line = xlBorderLine
.Weight = xlMedium 'xlThin 细线'xlThick粗线
.ColorIndex = 3 '3红色、4绿色
End With
With (Cells(l + hh, 1), Cells(l + hh, )).Font '字体设置
'.Size = 14
.Bold = True
'.Italic = True
.ColorIndex = 3
End With
With (Cells(l + hh, 1), Cells(l + hh, )).Interior '设置单元格底色
.ColorIndex = 8 '为青色
End With
Next columncount
Range(Cells(1, 1), Cells(l + 1, 2)).Locked = True
t
Cells(1, 1).Select
End Sub
Public Sub 删除分页汇总()
On Error Resume Next
ect
= False
llPageBreaks
lastline = [a65536].End(xlUp).Row
Set r1stSubCell = Range("Ah") ' 本例名单从 Ah 单元格开始
For Each rCurrentCell In Range(r1stSubCell, (xlDown))
For i = lastline To h Step -1
If Range("A" & i) = "本页合计" Or Range("A" & i) = "总合计" Then Range(i & ":" &
i).
Next i
Next rCurrentCell
End Sub
发布评论