|
|
Sub 单据打印()
Dim ar As Variant, br As Variant
Dim d As Object, dc As Object
Dim arr()
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
With Sheets("基础数据")
r = .Cells(Rows.Count, 1).End(xlUp).Row
If r < 2 Then MsgBox "基础数据为空！": End
ar = .Range("a1:e" & r)
End With
For i = 2 To UBound(ar)
If ar(i, 1) <> "" Then
d(ar(i, 1)) = i
End If
Next i
With Sheets("录入")
rs = .Cells(Rows.Count, 1).End(xlUp).Row
If rs < 2 Then MsgBox "录入表为空！": End
br = .Range("a2:k" & rs)
End With
With Sheets("打印")
rq = .[e2]
If rq = "" Then MsgBox "请选择日期！": End
If Not IsDate(rq) Then MsgBox "请输入标准日期！": End
ReDim arr(1 To UBound(ar), 1 To 15)
For i = 2 To UBound(br)
If br(i, 1) <> "" Then
If IsDate(br(i, 1)) Then
If br(i, 1) = rq Then
If gys = "" Then
gys = br(i, 11)
Else
gys = gys & "," & br(i, 11)
End If
n = n + 1
arr(n, 1) = br(i, 2)
xh = d(br(i, 2))
If xh <> "" Then
arr(n, 3) = ar(xh, 4)
If br(1, 2) = "玉米" Then
arr(n, 4) = ""
Else
arr(n, 4) = ar(xh, 3) & "KG/" & ar(xh, 4)
End If
If arr(n, 3) = "吨" Then
lh = 8
Else
lh = 6
End If
arr(n, 5) = br(i, lh)
arr(n, 6) = ar(xh, 5)
je = arr(n, 5) * arr(n, 6)
zs = Int(je)
gs = Len(zs)
w = 14
For s = gs To 1 Step -1
w = w - 1
arr(n, w) = Mid(zs, s, 1)
Next s
arr(n, w - 1) = ChrW(165)
If zs = je Then
arr(n, 14) = 0
arr(n, 15) = 0
Else
arr(n, 14) = Mid(je, Len(je) - 1, 1)
arr(n, 15) = Right(je, 1)
End If
End If
End If
End If
End If
Next i
.Range("a5:p8") = Empty
.Range("a19:p22") = Empty
.Range("g9:n9") = Empty
.Range("g23:n23") = Empty
.[a5].Resize(n, UBound(arr, 2)) = arr
.[a19].Resize(n, UBound(arr, 2)) = arr
.[o1] = gys
End With
MsgBox "ok!"
End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-7-16 22:32
楼主