|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
放到备注栏中
Sub 发货单()
Dim rng As Range
Set d = CreateObject("scripting.dictionary")
ar = Sheets("出仓原始数据").[a1].CurrentRegion
For i = 3 To UBound(ar)
If Trim(ar(i, 3)) <> "" And Trim(ar(i, 4)) <> "" Then
s = Trim(ar(i, 3)) & "|" & Trim(ar(i, 4))
d(s) = ""
End If
Next i
With Sheets("出货单")
For Each ss In .Shapes
ss.Delete
Next ss
.UsedRange.Clear
For Each k In d.keys
n = 0
ReDim br(1 To UBound(ar), 1 To 15)
For i = 3 To UBound(ar)
ss = Trim(ar(i, 3)) & "|" & Trim(ar(i, 4))
If ss = k Then
n = n + 1
br(n, 1) = n
br(n, 2) = ar(i, 5) & "-" & ar(i, 7) & "-" & ar(i, 4)
br(n, 3) = ar(i, 10)
br(n, 4) = ar(i, 9)
br(n, 5) = ar(i, 20)
br(n, 6) = ar(i, 11)
br(n, 7) = ar(i, 12)
br(n, 8) = ar(i, 22)
br(n, 9) = ar(i, 25)
br(n, 10) = ar(i, 19)
br(n, 11) = ar(i, 21)
br(n, 12) = ar(i, 13)
br(n, 13) = ar(i, 13) - ar(i, 22) - ar(i, 26)
If ar(i, 26) > 0 Then
br(n, 15) = "上次出货数量" & ar(i, 26)
Else
br(n, 15) = ""
End If
br(n, 14) = ar(i, 16)
bh = ar(i, 23)
sj = ar(i, 24)
End If
Next i
M = Sheets("出货单").Cells(Rows.Count, 1).End(xlUp).Row + 1
If M = 2 Then
M = 1
Else
M = M
End If
Sheets("样式表头").Rows("1:4").Copy .Cells(M, 1)
.Cells(M + 1, 2) = Split(k, "|")(0)
Set rng = Sheets("收货人信息").Columns(1).Find(Split(k, "|")(0), , , 1)
If Not rng Is Nothing Then
.Cells(M + 1, 8) = Sheets("收货人信息").Cells(rng.Row, 2)
.Cells(M + 1, 10) = Sheets("收货人信息").Cells(rng.Row, 3)
End If
.Cells(M + 1, 13) = bh
.Cells(M + 1, 15) = sj
.Cells(M + 4, 1).Resize(n, UBound(br, 2)) = br
.Cells(M + 4, 1).Resize(n, UBound(br, 2)).Borders.LineStyle = 1
Sheets("样式表头").Rows("10:11").Copy .Cells(M + n + 4, 1)
.Cells(M + n + 4, 8) = Application.Sum(Application.Index(br, 0, 8))
.Cells(M + n + 4, 9) = Application.Sum(Application.Index(br, 0, 9))
.Cells(M + n + 4, 12) = Application.Sum(Application.Index(br, 0, 12))
.Cells(M + n + 4, 13) = Application.Sum(Application.Index(br, 0, 13))
Next k
End With
End Sub
|
|