Andy2483

¦^´_ 2# ­ã´£³¡ªL


    ÁÂÁ½׾Â,ÁÂÁ«e½ú«ü¾É
«á¾ÇÂǦ¹©«¾Ç²ß«e½úªº¤è®×,¥H¤U¬O¤ß±oµù¸Ñ,½Ð«e½ú¦A«ü¾É

Sub TEST_A01()
Dim Arr, Brr, i&, V1&, V2&, N&, j%, k%, x%
'¡ô«Å§iÅܼÆ:(Arr, Brr)³q¥Î«¬,(i,V1,V2,N)ªø¾ã¼Æ,(j,k,x)µu¾ã¼Æ
Arr = Sheets("Sheet1").UsedRange
'¡ô¥OArrÅܼƬO¤Gºû°}¦C,¥HÀx¦s®æ­È±a¤J°}¦C¤¤
ReDim Brr(1 To 20000, 1 To 6)
'¡ô«Å§iBrrÅܼƬO ¤GºûªÅ°}¦C,Áa¦V1~20000,¾î¦V1~6
For x = 1 To 6: Brr(1, x) = Arr(1, x): Next
'¡ô³]¶¶°j°é!x±q1~6,±NArr°}¦C²Ä1¦C¸ê®Æ±a¤J Brr°}¦C²Ä1¦C¤¤
For i = 2 To UBound(Arr)
'¡ô³]¶¶°j°é!i±q2¨ì Arr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
    V1 = Int((Arr(i, 4) - 1) / Arr(i, 9))
    '¡ô¥OV1ÅܼƬO (i°j°é¦C4ÄæArr°}¦C­È-1)°£¥H i°j°é¦C9ÄæArr°}¦C­È,
    '³Ì«á¥h°£¤p¼Æªº¾ã¼Æ
    V2 = Arr(i, 4) - V1 * Arr(i, 9)
    '¡ô¥OV2ÅܼƬO i°j°é¦C4ÄæArr°}¦C­È-(V1ÅܼÆ*i°j°é¦C9ÄæArr°}¦C­È)
    For j = 12 To UBound(Arr, 2)
    '¡ô³]¶¶°j°é!j±q12¨ì Arr°}¦C¾î¦V³Ì¤j¯Á¤ÞÄ渹
        If Arr(i, j) = "" Then GoTo j01
        '¡ô¦pªGi°j°é¦Cj°j°éÄæArr°}¦C­È¬OªÅ¦r¤¸?
        'True´N¸õ¨ì¼Ð¥Üj01¦ì¸mÄ~Äò°õ¦æ
        For k = 1 To V1 + 1
        '¡ô³]¶¶°j°é!k±q1 ¨ì(V1ÅܼÆ+1)
            N = N + 1
            '¡ô¥ONÅܼƲ֥[1
            For x = 2 To 6: Brr(N + 1, x) = Arr(i, x): Next
            '¡ô±NArr°}¦Ci°j°é¦C(2~6)Äæ¸ê®Æ±a¤J Brr°}¦C¤U¤èªÅ¥Õ¦C
            Brr(N + 1, 1) = Arr(i, j)
            '¡ô¥O(N+1)¦C²Ä1ÄæBrr°}¦C­È¬O i°j°é¦Cj°j°éÄæArr°}¦C­È
            Brr(N + 1, 4) = IIf(k > V1, V2, Arr(i, 9))
            '¡ô¥O(N+1)¦C²Ä4ÄæBrr°}¦C­È¬O IIF()¦^¶Ç­È:
            '¦pªGkÅܼƤj©óV1ÅܼÆ,¦^¶ÇV2ÅܼÆ,
            '§_«h¦^¶Ç i°j°é¦C9ÄæArr°}¦C­È
        Next k
j01: Next j
Next i
With Sheets.Add
'¡ô¥H¤U¬OÃö©ó ·s¼W¤@­Ó¤u§@ªí«áªºµ{§Ç
     .[A1].Resize(N + 1, 6) = Brr
     '¡ô¥O¸Ó·sªí[A1]ÂX®i¦V¤U(N+1)¦C,¦V¥kÂX®i6ÄæÀx¦s®æ­È¥HBrr°}¦C±a¤J
     .Name = Format(Now, "yyyymmdd-hhmmss")
     '¡ô¥O¸Ó·sªíªí¦W¬O·í¤U®É¶¡¸g®æ¦¡¤Æ¬°«ü©w¤å¦r®æ¦¡ªº¦r¦ê
End With
End Sub
'=================================================
'¥H¤U¬O¦r¨å,Do Untilªº½m²ß,½Ð«e½ú¦A«ü¾É
Option Explicit
Sub TEST()
Dim Brr, Crr, Arr, V&, V2&, Z, i&, j%, R&, c%, T$
Set Z = CreateObject("Scripting.Dictionary")
Brr = Intersect(Sheet2.UsedRange, [H:IV])
For i = 2 To UBound(Brr): Z(Brr(i, 1)) = i: Next
Crr = Range([F1], [B65536].End(3)(1, 0))
ReDim Arr(20000, 1 To 6)
For j = 1 To 6: Arr(0, j) = Crr(1, j): Next
For i = 2 To UBound(Crr)
   T = Crr(i, 2): Z(T & "qty") = Val(Crr(i, 4))
   V2 = Brr(Z(T), 2): c = 0
   Do Until c = Brr(Z(T), 4)
      V = Z(T & "qty")
      Do Until V < 0
         R = R + 1
         For j = 2 To 6: Arr(R, j) = Crr(i, j): Next
         Arr(R, 1) = Brr(Z(T), 5 + c)
         Arr(R, 4) = IIf(V - V2 > 0, V2, V)
         V = V - V2
      Loop
      c = c + 1
   Loop
Next
With Sheets.Add
   .[A1].Resize(R + 1, 6) = Arr
   .Name = Format(Now, "yyyymmdd-hhmmss")
End With
End Sub