ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ¦p¦ó¨ú¦X­p¸ê®Æ

[µo°Ý] ¦p¦ó¨ú¦X­p¸ê®Æ

¦p¦ó¨ú¦X­p¸ê®Æ,½Ð¥ý¶i«üÂI,·P®¦.

¨úÁ`­p¸ê®Æ.rar (26.09 KB)

§ù¤p¥­

¦^´_ 1# dou10801
½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
Sub test()
Dim Arr, Brr, T, T1, i&, n%
Arr = Sheets(1).[a1].CurrentRegion
ReDim Brr(1 To UBound(Arr), 1 To 8)
For i = 5 To UBound(Arr)
    If Arr(i, 1) <> "" Then
        n = n + 1: Brr(n, 1) = Arr(i, 1)
        Brr(n, 2) = Arr(i, 2): Brr(n, 3) = Arr(i, 5)
        Brr(n, 4) = Arr(i, 6): Brr(n, 5) = Arr(i, 7)
        For i2 = i To UBound(Arr)
            If InStr(Arr(i2, 7), "¦X­p") Then
                Brr(n, 7) = Arr(i2, 11): Brr(n, 8) = Arr(i2, 12)
                T = T + Val(Brr(n, 7)): T1 = T1 + Val(Brr(n, 8))
                Exit For
            End If
        Next
    End If
Next
Brr(n + 1, 7) = T: Brr(n + 1, 8) = T1
Sheets(3).[j1].Resize(n + 1, 8) = Brr
End Sub

TOP

Sub TEST_A1()
Dim Arr, Brr, i&, j%, N&, S1, S2
Arr = Range(Sheets(1).[a1], Sheets(1).Cells(Rows.Count, "L").End(3))
ReDim Brr(1 To UBound(Arr), 1 To 8)
For i = 5 To UBound(Arr)
    If Arr(i, 1) <> "" Then
       N = N + 1
       For j = 1 To 5
           Brr(N, j) = Arr(i, Mid(12567, j, 1))
       Next j
    End If
    If Arr(i, 7) = "¦X­p:" And N > 0 Then
       Brr(N, 7) = Arr(i, 11): Brr(N, 8) = Arr(i, 12)
       S1 = S1 + Arr(i, 11): S2 = S2 + Arr(i, 12)
    End If
Next i
N = N + 1: Brr(N, 2) = "Á`­p": Brr(N, 7) = S1: Brr(N, 8) = S2
Sheets(3).[a:h].ClearContents
If N > 0 Then Sheets(3).[a1].Resize(N, 8) = Brr
End Sub

TOP

·PÁÂsamwang. ­ã´£³¡ªL ¤G¦ì«ü¾É,·P®¦.
§ù¤p¥­

TOP

¥»©«³Ì«á¥Ñ 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) = "¦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
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

(¿é¤J½s¸¹12036) googleºô§}:https://hcm19522.blogspot.com/
google"EXCEL°g"  blog  ©Îgoogleºô§}:https://hcm19522.blogspot.com/

TOP

        ÀR«ä¦Û¦b : §ïÅܦۤv¬O¦Û±Ï¡A¼vÅT§O¤H¬O±Ï¤H¡C
ªð¦^¦Cªí ¤W¤@¥DÃD