|
Sub 批量打印()
Application.ScreenUpdating = False
Dim ar As Variant
Dim br()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("Sheet1")
r = .Cells(Rows.Count, 1).End(xlUp).Row
If r < 2 Then MsgBox "Sheet1为空!": End
ar = .Range("a1:g" & r)
End With
For i = 2 To UBound(ar)
If ar(i, 3) <> "" Then
d(ar(i, 3)) = ""
End If
Next i
With Sheets("打印模板")
For Each k In d.keys
n = 0
sl = 0: pdsl = 0: cy = 0
ReDim br(1 To UBound(ar), 1 To UBound(ar, 2))
For i = 2 To UBound(ar)
If ar(i, 3) = k Then
n = n + 1
sl = sl + ar(i, 5)
'pdsl = pdsl + ar(i, 6)
cy = cy + ar(i, 7)
For j = 1 To UBound(ar, 2)
br(n, j) = ar(i, j)
Next j
End If
Next i
If n <= 53 Then
.UsedRange.Offset(3).Borders.LineStyle = 0
.UsedRange.Offset(3) = Empty
.[a2] = k
.[a4].Resize(n, UBound(br, 2)) = br
.[a4].Resize(n + 2, UBound(br, 2)).Borders.LineStyle = 1
.Cells(57, 1) = "当前页小计"
.Cells(57, 2) = n
.Cells(57, 4) = "数量"
.Cells(57, 5) = sl
.Cells(57, 6) = "差异"
.Cells(57, 7) = cy
.Cells(58, 1) = "总计"
.Cells(58, 2) = n
.Cells(58, 4) = "数量"
.Cells(58, 5) = sl
.Cells(58, 6) = "差异"
.Cells(58, 7) = cy
.PrintOut
'.PrintPreview
Else
For i = 1 To n Step 53
sll = 0: pdsll = 0: cyy = 0
.UsedRange.Offset(3).Borders.LineStyle = 0
.UsedRange.Offset(3) = Empty
m = 3
.[a2] = k
For s = i To i + 52
If s <= n Then
m = m + 1
For j = 1 To 7
.Cells(m, j) = br(s, j)
Next j
sll = sll + br(i, 5)
'pdsll = pdsll + br(i, 6)
cyy = cyy + br(i, 7)
End If
Next s
.[a3].Resize(m, UBound(br, 2)).Borders.LineStyle = 1
.Cells(57, 1) = "当前页小计"
.Cells(57, 2) = m - 3
.Cells(57, 4) = "数量"
.Cells(57, 5) = sll
.Cells(57, 6) = "差异"
.Cells(57, 7) = cyy
.Cells(58, 1) = "总计"
.Cells(58, 2) = n
.Cells(58, 4) = "数量"
.Cells(58, 5) = sl
.Cells(58, 6) = "差异"
.Cells(58, 7) = cy
.PrintOut
'.PrintPreview
Next i
End If
Next k
End With
Application.ScreenUpdating = False
MsgBox "打印完毕!"
End Sub
|
|