Sub 装箱()
Dim i, t, p, q, irow, mxgs, xs As Integer
Dim ar, br
mxgs = Val(InputBox("请输入单箱装箱商品数量: "))
If mxgs <= 0 Then
Exit Sub
Next
irow = Sheets("广州千速纺织品有限公司BBTPECG2400003-货运单导入").[b65536].End(xlUp).Row
ar = Sheets("广州千速纺织品有限公司BBTPECG2400003-货运单导入").Range("a1:l" & irow)
ReDim br(1 To 10000, 1 To UBound(ar, 2))
For i = 1 To irow
If i = 1 Then
t = t + 1
For p = 1 To UBound(ar, 2)
br(t, p) = ar(i, p)
Next
End If
If i >= 2 Then
If Int(ar(i, UBound(ar, 2)) / mxgs) = ar(i, UBound(ar, 2)) / mxgs Then
xs = Int(ar(i, UBound(ar, 2)) / mxgs)
Else
xs = Int(ar(i, UBound(ar, 2)) / mxgs) + 1
End If
If xs = 1 Then
t = t + 1
For p = 1 To UBound(ar, 2)
br(t, p) = ar(i, p)
Next
End If
If xs >= 2 Then
For q = 1 To xs
t = t + 1
For p = 1 To UBound(ar, 2) - 2
br(t, p) = ar(i, p)
Next
br(t, UBound(ar, 2) - 1) = WorksheetFunction.Min(mxgs, ar(i, UBound(ar, 2)) - (q - 1) * mxgs)
br(t, UBound(ar, 2)) = br(t, UBound(ar, 2) - 1)
Next
End If
End If
Next
Sheets("明细装箱单").[a1].Resize(t * 2, UBound(ar, 2)).Clear
Sheets("明细装箱单").[a1].Resize(t * 2, UBound(ar, 2)) = br
MsgBox "ok"
End Sub |