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

[µo°Ý] ¦p¦ó±N¤T­Óªí®æ¦X¨Ö¦b¤@­Óªí®æ¸Ì?(¥¨¶°°õ¦æ¥X¿ù)

[µo°Ý] ¦p¦ó±N¤T­Óªí®æ¦X¨Ö¦b¤@­Óªí®æ¸Ì?(¥¨¶°°õ¦æ¥X¿ù)

¦U¦ì¤j¤j±z¦n¡A

Ãö©ó³o­Óµo°Ý¡A¤§«e­ã´£¤j¤j¤w¦³´£¨Ñ¸Ñªk¡G³sµ²¡C

¦ý¬O¦]¬°­n¦bFÄæ¼W¥[¹Bºâ¡GEÄ檺­È³£­¼¤W5¡C

©Ò¥H§Ú¦³§â¥¨¶°µy°µ§ó§ï¦p¤U¡A¬°¤F¤£­n§âFÄæ§R°£±¼¡G

­ì¥»¡GSheets("Á`ªí").UsedRange.Clear
§ó§ï¦¨¡G
Sheets("Á`ªí").Select
Columns("A:E").Select
Selection.ClearContents

­ì¥»¤£·|¥X¿ù¡C¦ý¦pªGµ§¼Æ´î¤Ö«á¡A¦b°õ¦æ®É¡A´N·|¥X¿ù¡A¦p¤U2­Ó¹Ï¡C
Â^¨ú.PNG
2020-10-13 20:45

Â^¨ú2.PNG
2020-10-13 20:45


¦]¦¹·Q½Ð°Ý¸Ó¦p¦ó¸Ñ¨M©O? ¬O§_¥¨¶°­n¦A°µ§ó§ï©O?

ªþ¤WªþÀÉ¡G ÀÉ®×1.zip (17.41 KB)

¦A³Â·Ð¤j®a¨ó§U¡A·PÁ¡C

¦^´_ 1# gaishutsusuru

¬õ¦r­×¥¿
Sub TEST()
Dim Arr, Brr, xD, i&, j&, R&, C&, U&, T$

Sheets("Á`ªí").Select
Columns("A:E").Clear


Set xD = CreateObject("Scripting.Dictionary")
ReDim Brr(1 To 2000, 1 To 99)
Brr(1, 1) = "¸¹½X"
For i = 1 To Sheets.Count
    If Left(Sheets(i).Name, 1) <> "X" Then GoTo i99
    C = C + 1: Brr(1, C + 1) = Sheets(i).Name
    Arr = Sheets(i).UsedRange
    For j = 2 To UBound(Arr)
        T = Arr(j, 1): If T = "" Then GoTo j99
        U = xD(T)
        If U = 0 Then R = R + 1: U = R: xD(T) = R: Brr(U + 1, 1) = T
        Brr(U + 1, C + 1) = Brr(U + 1, C + 1) + Arr(j, 2)
j99: Next j
i99: Next i
With Sheets("Á`ªí").[a1].Resize(R + 1, C + 2)
     .Columns(1).NumberFormatLocal = "@"
     .Value = Brr
     .Sort Key1:=.Item(1), Order1:=xlAscending, Header:=xlYes
     .Columns(C + 2) = "=SUM(RC[-" & C & "]:RC[-1])"
     .Rows(R + 2) = "=n(SUM(R[-" & R & "]C:R[-1]C))"
     .Cells(1, C + 2) = "¦X­p": .Cells(R + 2, 1) = "¦X­p"
     Union(.Rows(1), .Rows(R + 2), .Columns(C + 2)).Font.Bold = True
End With
End Sub

TOP

¦^´_ 2# jcchiang

°Ú~­ì¨Ó°ÝÃD¥X¦b³o¸Ì¡A¥i¥H¥Î¤F¡A·PÁÂjcchiang¤j¤jªº¨ó§U¡C:)

TOP

¦pªG¤u§@ªí¼Æ¶q¤£½T©w, µy­×¦p¤U:
ÀÉ®×1-1.rar (16.48 KB)

TOP

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



ÁÂÁ­㴣¤j¤jªº¦^ÂСA§Ú¨Ó¸Õ¬Ý¬Ý¡C

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-3-7 14:36 ½s¿è

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


    ÁÂÁ«e½ú

Sub THK()
MsgBox [A1].Address(0, 0)
'¡ô¬O¥h°£¥þ³¡¦ì§}¤¤ªº"$"²Å¸¹,¦b¤½¦¡¤¤¬O¤£©T©w¦C¦ì¤]¤£©T©wÄæ¦ì
MsgBox [A1].Address(1, 0)
'¡ô¬O¥h°£¦ì§}¤¤Ä渹«eªº"$"²Å¸¹,¦b¤½¦¡¤¤¬O©T©w¦C¦ì¦ý¤£©T©wÄæ¦ì
MsgBox [A1].Address(0, 1)
'¡ô¬O¥h°£¦ì§}¤¤¦C¼Æ«eªº"$"²Å¸¹,¦b¤½¦¡¤¤¬O¤£©T©w¦C¦ì¦ý©T©wÄæ¦ì
MsgBox [A1].Address(1, 1)
'¡ô¦b¤½¦¡¤¤¬O©T©w¦C¦ì¤]©T©wÄæ¦ì,(1, 1)¥i¬Ù²¤
End Sub


Sub TEST()
Dim Arr, Brr, xD, i&, j&, R&, C&, U&, T$
'¡ô«Å§iÅܼÆ:(Arr,Brr,xD)¬O³q¥Î«¬ÅܼÆ,(i,j,R,C,U)¬Oªø¾ã¼ÆÅܼÆ,T¬O¦r¦êÅܼÆ
Sheets("Á`ªí").UsedRange.Clear
'¡ô¥OÁ`ªí¤u§@ªí¦³¨Ï¥ÎÀx¦s®æ°µ ²M°£
Set xD = CreateObject("Scripting.Dictionary")
'¡ô¥OxD³o³q¥Î«¬ÅܼƬO ¦r¨å
ReDim Brr(1 To 2000, 1 To 99)
'¡ô«Å§iBrr³o³q¥Î«¬ÅܼƬO ¤Gºû°}¦C!½d³ò¤j¤p:Áa¦V±q1 ¨ì2000,¾î¦V±q1 ¨ì99
Brr(1, 1) = "¸¹½X"
'¡ô¥O²Ä1¦C²Ä1ÄæBrr°}¦C­È¬O "¸¹½X" ¦r¦ê
For i = 1 To Sheets.Count
'¡ô³]¶¶°j°é!i±q1 ¨ì ¤u§@ªí¼Æ¶q(¦pªG¦³³QÁôÂêº,¤]ºâ)
    If Left(Sheets(i).Name, 1) <> "X" Then GoTo i99
    '¡ô¦pªG²Äi°j°é­Ó¤u§@ªí¦W¦r¥ª°¼¨º­Ó¦r¤¸¤£¬O "X"!´N¸õ¨ì i99¦ì¸mÄ~Äò°õ¦æ
    C = C + 1: Brr(1, C + 1) = Sheets(i).Name
    '¡ô¥OC³oªø¾ã¼ÆÅܼƲ֥[ 1
    '¦A¥O²Ä1¦C(CÅܼÆ+1)Ä檺Brr°}¦C­È¬O ²Äi°j°é­Ó¤u§@ªí¦W¦r

    Arr = Sheets(i).UsedRange
    '¡ô¥OArr³o³q¥Î«¬ÅܼƬO ¤Gºû°}¦C!
    '¥Hi°j°é¤u§@ªí¦³¨Ï¥ÎÀx¦s®æÂX®i³Ì¤p¤è¥¿½d³òÀx¦s®æ­È±a¤J

    For j = 2 To UBound(Arr)
    '¡ô³]¶¶°j°é!j±q2 ¨ìArr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
        T = Arr(j, 1): If T = "" Then GoTo j99
        '¡ô¥OT³o¦r¦êÅܼƬO j°j°é¦C²Ä1ÄæArr°}¦C­È,
        '¦A¦pªGTÅܼƬOªÅ¦r¤¸´N¸õ¨ì j99¦ì¸mÄ~Äò°õ¦æ

        U = xD(T)
        '¡ô¥OU³oªø¾ã¼Æ¬O ¥HTÅܼƬdxD¦r¨å¦^¶ÇªºItem­È
        If U = 0 Then R = R + 1: U = R: xD(T) = R: Brr(U + 1, 1) = T
        '¡ô¦pªGUÅܼƬO 0!´N
        '¥OR³oªø¾ã¼ÆÅܼƲ֥[1:¥OUÅܼƸˤJRÅܼÆ:¥O¥HTÅܼƷíKey,Item¬O RÅܼƯǤJxD¦r¨å
        '¥O(UÅܼÆ+1)¦C²Ä1ÄæBrr°}¦C­È¬O TÅܼÆ

        Brr(U + 1, C + 1) = Brr(U + 1, C + 1) + Arr(j, 2)
        '¡ô¥O(UÅܼÆ+1)¦C²Ä(CÅܼÆ+1)ÄæBrr°}¦C­È¬O ¦Û¨­+j°j°é²Ä2ÄæArr°}¦C­È
j99: Next j
i99: Next i
With Sheets("Á`ªí").[A1].Resize(R + 2, C + 3)
'¡ô¥H¤U¬OÃö©óÁ`ªí¤u§@ªí[A1]ÂX®i¦V¤U(RÅܼÆ+2)¦C,¦V¥kÂX®i(CÅܼÆ+ 3)Ä檺½d³òÀx¦s®æ µ{§Ç
     .Cells(2, 1).Resize(R).NumberFormatLocal = "@"
     '¡ô¥OWith½d³òªº²Ä2¦C²Ä1ÄæÀx¦s®æ¦V¤UÂX®iRÅܼƦCªº½d³òÀx¦s®æ®æ¦¡¬O ¤å¦r
     .Value = Brr
     '¡ô¥OWith½d³òªºÀx¦s®æ­È¥HBrr°}¦C­È±a¤J
     .Borders.LineStyle = 1
     '¡ô¥OWith½d³òªºÀx¦s®æ®Ø½u¬O ²Ó¹ê½u
     .Sort Key1:=.Item(1), Order1:=xlAscending, Header:=xlYes
     '¡ô¥OWith½d³òªºÀx¦s®æ¥HWith½d³ò²Ä1®æ¬°°ò·Ç°µ1¼h¦¸¦³¼ÐÃD¦Cªº¶¶±Æ§Ç
     .Columns(C + 2) = "=SUM(" & .Cells(1, 2).Resize(1, C).Address(0, 0) & ")"
     '¡ô¥OWith½d³òªº(CÅܼÆ+2)Äæ¬O¤½¦¡ "=SUM("¦r¦ê ³s±µ Àx¦s®æ¦ì§} ¦A³s±µ ")"¦r¤¸
     'Àx¦s®æ¦ì§}:With½d³ò²Ä1¦C²Ä2ÄæÀx¦s®æÂX®i¦V¥kCÅܼÆÄæ,¦¹½d³òÀx¦s®æ¦ì§}(¥h°£¥þ³¡$²Å¸¹)

     .Columns(C + 3) = "=" & .Cells(1, C + 2).Address(0, 0) & "*5"
     '¡ô¥OWith½d³òªº(CÅܼÆ+3)Äæ¬O¤½¦¡ "="¦r¤¸ ³s±µ Àx¦s®æ¦ì§} ¦A³s±µ "*5"¦r¦ê
     'Àx¦s®æ¦ì§}:²Ä1¦C²Ä(CÅܼÆ+2)ÄæÀx¦s®æ¦ì§}(¥h°£¥þ³¡$²Å¸¹)

     .Rows(R + 2) = "=N(SUM(" & .Cells(2, 1).Resize(R).Address(0, 0) & "))"
     '¡ô¥OWith½d³òªº(RÅܼÆ+2)¦C¬O¤½¦¡ "=N(SUM("¦r¦ê ³s±µ Àx¦s®æ¦ì§} ¦A³s±µ "))"¦r¦ê
     'Àx¦s®æ¦ì§}:[A2]Àx¦s®æÂX®i¦V¤URÅܼƦC,¦¹½d³òÀx¦s®æ¦ì§}(¥h°£¥þ³¡$²Å¸¹)
     'https://support.microsoft.com/zh-tw/office/n-%E5%87%BD%E6%95%B8-a624cad1-3635-4208-b54a-29733d1278c9

     .Cells(1, C + 2) = "¦X­p": .Cells(1, C + 3) = "ª÷ÃB": .Cells(R + 2, 1) = "¦X­p"
     '¡ô¥OWith½d³òªºÀx¦s®æ²Ä1¦C(CÅܼÆ+2)ÄæÀx¦s®æ­È¬O "¦X­p" ¦r¦ê
     '¡ô¥OWith½d³òªºÀx¦s®æ²Ä1¦C(CÅܼÆ+3)ÄæÀx¦s®æ­È¬O "ª÷ÃB" ¦r¦ê
     '¡ô¥OWith½d³òªºÀx¦s®æ²Ä(R+2)¦C²Ä1ÄæÀx¦s®æ­È¬O "¦X­p" ¦r¦ê

     Union(.Rows(1), .Rows(R + 2), .Columns(C + 2), .Columns(C + 3)).Font.Bold = True
     '¡ô¥OÀx¦s®æ¶°ªº¤å¦r¥H ²ÊÅéÅã¥Ü
     'Àx¦s®æ¶°:With½d³òªº(²Ä1¦C,²ÄRÅܼÆ+2¦C,CÅܼÆ+2Äæ,CÅܼÆ+3Äæ)

End With
End Sub
'´X¥G³£°Ñ¼Æ¤Æ¤F!¾Ç²ß¨ì«Ü¦hª¾ÃÑ!ÁÂÁÂ
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : §Ú­Ì³Ì¤jªº¼Ä¤H¤£¬O§O¤H¡D¥i¯à¬O¦Û¤v¡C
ªð¦^¦Cªí ¤W¤@¥DÃD