- ©«¤l
- 1440
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1464
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-9-30
|
¥»©«³Ì«á¥Ñ 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 |
|