Andy2483

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


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

¸ê®Æªí:

¤U¸ü (186.37 KB)

2023-11-20 08:44

°õ¦æµ²ªG:

¤U¸ü (156.62 KB)

2023-11-20 08:45

Option Explicit
Sub TEST_A1()
Dim Arr, Brr, i&, j%, N&, S1, S2
'¡ô«Å§iÅܼÆ&¬Oªø¾ã¼Æ,%¬Oµu¾ã¼Æ,¨S¦³²Å¸¹ªº¬O³q¥Î«¬ÅܼÆ
Arr = Range(Sheets(1).[A1], Sheets(1).Cells(Rows.Count, "L").End(3))
'¡ô¥OArr³o³q¥Î«¬ÅܼƬO ªí1ªº[A1]¨ì LÄæ³Ì«á¦³¤º®eÀx¦s®æ½d³ò­Èªº¤Gºû°}¦C
ReDim Brr(1 To UBound(Arr), 1 To 8)
'¡ô«Å§iBrr³o³q¥Î«¬ÅܼƬO¤GºûªÅ°}¦C,Áa¦V¯Á¤Þ¸¹±q1¨ì ArrÁa¦V³Ì¤j¯Á¤Þ¦C¸¹,
'¾î¦V1~8¯Á¤Þ¸¹
For i = 5 To UBound(Arr)
'¡ô³]¶¶°j°é!i±q1¨ì ArrÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
    If Arr(i, 1) <> "" Then
    '¡ô¦pªGi°j°é¦C1Äæ°}¦C­È¤£¬OªÅ¦r¤¸?
       N = N + 1
       '¡ô¥ON³oªø¾ã¼ÆÅܼƲ֥[1
       For j = 1 To 5
       '¡ô³]¶¶°j°é!j±q1~5
           Brr(N, j) = Arr(i, Mid(12567, j, 1))
           '¡ô¥OArr°}¦Ci°j°é¦C1,2,5,6,7Äæ°}¦C­È,±a¤JBrr°}¦Cªº
           'NÅܼƦCªº1,2,3,4,5Äæ
       Next j
    End If
    If Arr(i, 7) = "¦X­p:" And N > 0 Then
    '¡ô¦pªGi°j°é¦C²Ä7ÄæArr°}¦C­È¬O "¦X­p:",¦Ó¥BNÅܼƤj©ó0??
       Brr(N, 7) = Arr(i, 11): Brr(N, 8) = Arr(i, 12)
       '¡ô¥ONÅܼƦC²Ä7ÄæBrr°}¦C­È¬O i°j°é¦C²Ä11ÄæArr°}¦C­È
       '¡ô¥ONÅܼƦC²Ä8ÄæBrr°}¦C­È¬O i°j°é¦C²Ä12ÄæArr°}¦C­È
       S1 = S1 + Arr(i, 11): S2 = S2 + Arr(i, 12)
       '¡ô¥OS1ÅܼƬO¦Û¨­­È²Ö¥[ i°j°é¦C²Ä11ÄæArr°}¦C­È
       '¡ô¥OS2ÅܼƬO¦Û¨­­È²Ö¥[ i°j°é¦C²Ä12ÄæArr°}¦C­È
    End If
Next i
N = N + 1: Brr(N, 2) = "Á`­p": Brr(N, 7) = S1: Brr(N, 8) = S2
'¡ô¥ONÅܼƲ֥[1,¥ONÅܼƦC²Ä2ÄæBrr°}¦C­È¬O "Á`­p"¦r¦ê
'¥ONÅܼƦC²Ä7ÄæBrr°}¦C­È¬OS1ÅܼÆ,¥ONÅܼƦC²Ä8ÄæBrr°}¦C­È¬OS2ÅܼÆ
Sheets(3).[a:h].ClearContents
'¡ô¥Oªí3ªº[A:H]Àx¦s®æ²M°£¤º®e
If N > 0 Then Sheets(3).[A1].Resize(N, 8) = Brr
'¡ô¦pªGNÅܼƤj©ó0?
'True´N¥Oªí3ªº[A1]ÂX®i¦V¤UNÅܼƦC,¦V¥k8Äæ½d³òÀx¦s®æ­È,¥HBrr°}¦C±a¤J
End Sub
'=======================================================
¥H¤U¬O½m²ß¤è®×,½Ð«e½ú¦A«ü±Ð

Option Explicit
Sub TEST()
Dim Brr, Q, B1%, B2%, i&, j%, R&
Brr = Range(¤u§@ªí1.[A1], ¤u§@ªí1.Cells(Rows.Count, 12).End(xlUp))
Q = [{1,2,5,6,7}]
For i = 5 To UBound(Brr)
   B1 = Brr(i, 2) <> "": B2 = Brr(i, 7) = "¦X­p:"
   If B1 Then
      R = R + 1: Brr(R, 6) = ""
      For j = 1 To 5: Brr(R, j) = Brr(i, Q(j)): Next
   End If
   If B2 Then Brr(R, 7) = Brr(i, 11): Brr(R, 8) = Brr(i, 12)
i01: Next
If R = 0 Then Exit Sub
With ¤u§@ªí4.[A1].Resize(R, 8)
   .EntireColumn.ClearContents
   .Value = Brr
   .Item(.Count + 2) = "¦X­p"
   .Item(.Count + 7).Resize(, 2) = "=SUM(G1:G" & R & ")"
End With
End Sub