­ã´£³¡ªL

Sub ¤À©î¼Æ¶q()
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


====================================

­ã´£³¡ªL

¦^´_ 3# hcm19522


RANDBETWEEN §Úªºª©¥»(2000)µLªkºc¦¨°}¦C, ©Ò¥H, ³oºØÃD§Ú¤j³£¤£µª,
¹ê»Ú¹B¥Î, ÁÙ¬O¥Îrand°µ»²§U§a! ¤£·Q¦b¤é±`¥Î¤£¨ìªº¤½¦¡¤W°µ¤å³¹~~