Sub 分拆數量()
Dim Arr, Brr, i&, j%, k%, C&, Qty&, U&, V&, N&
Arr = Range([I1], [A65536].End(xlUp))
ReDim Brr(1 To 30000, 1 To 9)
For i = 2 To UBound(Arr)
If i > 2 And Arr(i, 9) <> Arr(i - 1, 9) Then N = N + 1
C = 3000: If Arr(i, 8) = "RED" Then C = 1000
Qty = Arr(i, 4): U = 0
For j = 1 To Int((Qty - 1) / C) + 1
N = N + 1
For k = 1 To 9: Brr(N, k) = Arr(i, k): Next
Brr(N, 5) = U + 1
V = IIf(Qty > C, C, Qty)
U = U + V
Qty = Qty - V
Brr(N, 6) = U + IIf(Qty > 100, 0, Qty)
Brr(N, 7) = V + IIf(Qty > 100, 0, Qty)
If Qty <= 100 Then Exit For
Next j
Next i
Sheets(1).[A1:I1] = Arr
Sheets(1).[A2:I3].Resize(N) = Brr
End Sub
