|
|
Sub 装箱统计()
Application.ScreenUpdating = False
Dim ar As Variant, br As Variant
Dim i As Long, r As Long, rs As Long
Dim arr()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("订单明细")
r = .Cells(Rows.Count, 1).End(xlUp).Row
If r < 4 Then MsgBox "订单明细为空！": End
ar = .Range("a3:h" & r)
End With
With Sheets("装箱明细")
rs = .Cells(Rows.Count, 1).End(xlUp).Row
If rs < 4 Then MsgBox "装箱明细为空！": End
br = .Range("a3:i" & rs)
End With
ReDim arr(1 To UBound(ar), 1 To 16)
With Sheets("箱号统计")
dh = .[r2]
If dh = "" Then MsgBox "请输入查询单号！": End
For i = 2 To UBound(br)
If br(i, 2) <> "" Then
dh_1 = Left(br(i, 2), 8)
If Val(dh_1) = dh Then
zf = br(i, 4) & "|" & br(i, 5) & "|" & br(i, 6)
If d(zf) = "" Then
d(zf) = i
Else
d(zf) = d(zf) & "|" & i
End If
End If
End If
Next i
For i = 2 To UBound(ar)
If ar(i, 2) = dh Then
n = n + 1
For j = 3 To 7
arr(n, j - 2) = ar(i, j)
Next j
End If
zd = arr(n, 1) & "|" & arr(n, 2) & "|" & arr(n, 3)
m = d(zd)
lh = 6
For Each k In Split(m, "|")
arr(n, lh) = br(k, 2)
arr(n, lh + 1) = br(k, 8)
lh = lh + 2
arr(n, 14) = arr(n, 14) + br(k, 8)
arr(n, 15) = arr(n, 5) - arr(n, 14)
Next k
Next i
.UsedRange.Offset(4).Borders.LineStyle = 0
.UsedRange.Offset(4) = Empty
.[a5].Resize(n, 16) = arr
.[a5].Resize(n, 16).Borders.LineStyle = 1
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-5-20 07:31
楼主
