Andy2483

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


    ÁÂÁ½׾Â,ÁÂÁ«e½ú«ü¾É
«á¾Ç¾Ç²ß«e½úªº¤è®×,¤ß±oµù¸Ñ¦p¤U,½Ð«e½ú¦A«ü¾É

Option Explicit
Sub TEST_A1()
Dim Arr, Brr, i&, N&, R&, j%, k%, Cn%, V%, V1%, V2%
'¡ô«Å§iÅܼÆ:(Arr,Brr)¬O³q¥Î«¬ÅܼÆ,(N,R)¬Oªø¾ã¼Æ,(j,k,Cn,V,V1,V2)¬Oµu¾ã¼Æ
Sheets("Sheet2").[a:j].ClearContents
'¡ô¥O¦W¬°"Sheet2" ¤u§@ªíªºA:JÄæÀx¦s®æ²M°£¤º®e
Arr = Range(Sheets("Sheet1").[j1], Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp)(2))
'¡ô¥OArr³o³q¥Î«¬ÅܼƬO ¤Gºû°}¦C,¥Hªí1ªº[J1]¨ìAÄæ³Ì«á¦³¤º®eÀx¦s®æªº¤U¤@®æ,¥H¦¹½d³òÀx¦s®æ­È±a¤JArr°}¦C¤¤
ReDim Brr(1 To 30000, 1 To 10)
'¡ô«Å§iBrr³o³q¥Î«¬ÅܼƬO¤GºûªÅ°}¦C,Áa¦V½d³ò±q¯Á¤Þ¸¹1¨ì30000,¾î¦V½d³ò±q¯Á¤Þ¸¹1 ¨ì10
For i = 2 To UBound(Arr) - 1
'¡ô³]¶¶°j°é!i±q2 ¨ìArr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹-1
  V = IIf(Arr(i, 10) = "HT", 1000, 3000) '°£¼Æ
    '¡ô¥OV³oµu¾ã¼Æ¬O IIF()¦^¶Ç­È:¦pªGi°j°é¦C²Ä10ÄæArr°}¦C­È¦Û¦r¦ê "HT",True¦^¶Ç¼Æ­È1000,False¦^¶Ç¼Æ­È 3000
    V1 = Val(Arr(i, 7)) '¼Æ¶q
    '¡ô¥OV1³oµu¾ã¼Æ¬O i°j°é¦C²Ä7ÄæArr°}¦C­ÈÂন¼Æ­È
    Cn = Int(V1 / V) + 1 '¤À©î¦æ¼Æ
    '¡ô¥OCn³oµu¾ã¼Æ¬O V1Åܼư£¥HVÅܼƫá¥h°£¤p¼Æªº¾ã¼Æ­È+1
    V2 = V1 Mod V '¾l¼Æ
    '¡ô¥OV2³oµu¾ã¼Æ¬O V1Åܼư£¥HVÅܼƪº¾l¼Æ
    If V2 < 101 And Cn > 1 Then Cn = Cn - 1: V2 = V + V2
    '¡ô¦pªGV2ÅܼÆ<101 ¥BCnÅܼÆ>1 ? True´N¥OCnÅܼÆ-1:¥OV2ÅܼƬO¦Û¨­²Ö¥[VÅܼÆ
    For j = 1 To Cn
    '¡ô³]¶¶°j°é!j±q1 ¨ìCnÅܼÆ
        N = N + 1
        '¡ô¥ONÅܼƲ֥[1
        For k = 1 To 10: Brr(N, k) = Arr(i, k): Next
        '¡ô³]¶¶°j°é!¥Ok±q1¨ì10:±Ni¦CkÅܼÆÄæArr°}¦C­È±a¤J NÅܼƦCkÅܼÆÄæBrr°}¦C¤¤
        Brr(N, 7) = IIf(j = Cn, V2, V)
        '¡ô¥ONÅܼƦC²Ä7Äæ°}¦C­È¬OIIF()¦^¶Ç­È: ¦pªGjÅܼƦPCnÅܼÆ!¦^¶ÇV2ÅܼÆ,§_«h¦^¶ÇVÅܼÆ
    Next j
    If Arr(i, 8) <> Arr(i + 1, 8) And N Mod 2 = 1 Then N = N + 1
    '¡ô¦pªGi°j°é¦C²Ä8ÄæArr°}¦C­È»P¤U¤@¦C²Ä8ÄæArr°}¦C­È¤£¦P,¥BNÅܼư£¥H2ªº¾l¼Æ¬O1?
    'True´N¥ONÅܼƲ֥[1
Next i
Sheets("Sheet2").[a1:j1] = Sheets("Sheet1").[a1:j1].Value
'¡ô¥Oªí2ªº¼ÐÃD¦C¦P ªí1ªº¼ÐÃD¦C
Sheets("Sheet2").[a2].Resize(N, 10) = Brr
'¡ô¥Oªí2ªº[A2]ÂX®i¦V¤UNÅܼƦC,ÂX®i¦V¥k10Ä檺½d³òÀx¦s®æ­È¥HBrr°}¦C­È±a¤J
End Sub
===========================================================

Option Explicit
Sub TEST()
Dim Brr, Crr, V%, V1%, Q%, i&, j%, R&
Dim S1 As Worksheet, S2 As Worksheet
Set S1 = Sheets("Sheet1"): Set S2 = Sheets("Sheet2")
Brr = Range(S1.[J1], S1.Cells(Rows.Count, "A").End(3))
ReDim Crr(1 To 10000, 1 To 10)
For i = 2 To UBound(Brr)
   Q = Val(Brr(i, 7))
   V = IIf(Brr(i, 10) = "HT", 1000, 3000)
qq:
   If Q <= 0 Then GoTo i01 Else R = R + 1: V1 = Q - V
   For j = 1 To 10: Crr(R, j) = Brr(i, j): Next
   Crr(R, 7) = V * -(V1 >= 0) + Q * -(V1 < 0)
   Q = V1: GoTo qq
i01: Next
S2.[A:J].ClearContents
S2.[A1:J1] = S1.[A1:J1].Value
S2.[a2].Resize(R, 10) = Crr
Set S1 = Nothing: Set S2 = Nothing: Erase Brr, Crr
End Sub