- ©«¤l
 - 1527 
 - ¥DÃD
 - 40 
 - ºëµØ
 - 0 
 - ¿n¤À
 - 1551 
 - ÂI¦W
 - 0  
 - §@·~¨t²Î
 - Windows  7 
 - ³nÅ骩¥»
 - Excel 2010 & 2016 
 - ¾\ŪÅv
 - 100 
 - ©Ê§O
 - ¨k 
 - ¨Ó¦Û
 - ¥xÆW 
 - µù¥U®É¶¡
 - 2020-7-15 
 - ³Ì«áµn¿ý
 - 2025-11-4 
 
  | 
                
 ¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-11-20 10:53 ½s¿è  
 
¦^´_ 3# ã´£³¡ªL  
 
 
    ÁÂÁ½׾Â,ÁÂÁ«e½ú«ü¾É 
«á¾ÇÂǦ¹©«¾Ç²ß«e½úªº¤è®×,¾Ç²ß¤ß±oµù¸Ñ¦p¤U,½Ð«e½ú¦A«ü¾É 
 
¸ê®Æªí: 
 
 
 
 
°õ¦æµ²ªG: 
 
 
 
 
 
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) = "¦Xp:" And N > 0 Then 
    '¡ô¦pªGi°j°é¦C²Ä7ÄæArr°}¦CȬO "¦Xp:",¦Ó¥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) = "¦Xp:" 
   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) = "¦Xp" 
   .Item(.Count + 7).Resize(, 2) = "=SUM(G1:G" & R & ")" 
End With 
End Sub |   
 
 
 
 |