Sub scpj()
Application.ScreenUpdating = False
With Sheets("统计表")
r = .Cells(Rows.Count, 1).End(xlUp).Row
If r < 2 Then MsgBox "统计表为空！": End
ar = .Range("a1:u" & r)
End With
Set rn = Sheets("票据模版").Rows("2:15")
With Sheets("票据打印")
yf = .[j1]
If yf = "" Then MsgBox "请选择月份！": End
rs = .Cells(Rows.Count, 1).End(xlUp).Row
If rs > 1 Then .Rows("2:" & rs).Delete
For i = 2 To UBound(ar)
If ar(i, 1) <> "" Then
If IsDate(ar(i, 1)) Then
yf_1 = Month(ar(i, 1))
If yf_1 = yf Then
m = m + 1
ws = .Cells(Rows.Count, 1).End(xlUp).Row + 3
If ws = 4 Then
ws = 2
Else
ws = ws
End If
rn.Copy .Cells(ws, 1)
.Cells(ws, 7) = "No:1" & Format(m, "00000")
.Cells(ws + 1, 7) = ar(i, 1)
.Cells(ws + 2, 2) = ar(i, 2)
.Cells(ws + 2, 4) = ar(i, 3)
.Cells(ws + 2, 6) = ar(i, 4)
.Cells(ws + 4, 2) = ar(i, 5)
.Cells(ws + 4, 3) = ar(i, 6)
.Cells(ws + 4, 4) = ar(i, 7)
.Cells(ws + 4, 5) = ar(i, 8)
.Cells(ws + 4, 6) = ar(i, 9)
.Cells(ws + 5, 2) = ar(i, 10)
.Cells(ws + 5, 3) = ar(i, 11)
.Cells(ws + 5, 4) = ar(i, 12)
.Cells(ws + 5, 5) = ar(i, 13)
.Cells(ws + 5, 6) = ar(i, 14)
.Cells(ws + 6, 2) = ar(i, 18)
.Cells(ws + 6, 6) = ar(i, 18)
.Cells(ws + 7, 2) = ar(i, 15)
.Cells(ws + 7, 6) = ar(i, 15)
.Cells(ws + 8, 2) = ar(i, 16)
.Cells(ws + 8, 6) = ar(i, 16)
.Cells(ws + 9, 2) = ar(i, 17)
.Cells(ws + 9, 6) = ar(i, 17)
End If
End If
End If
Next i
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-3-7 11:56
楼主