| ©«¤l1517 ¥DÃD40 ºëµØ0 ¿n¤À1541 ÂI¦W0  §@·~¨t²ÎWindows  7 ³nÅ骩¥»Excel 2010 & 2016 ¾\ŪÅv100 ©Ê§O¨k ¨Ó¦Û¥xÆW µù¥U®É¶¡2020-7-15 ³Ì«áµn¿ý2025-10-31 
 | 
                
| ¥»©«³Ì«á¥Ñ 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) = "¦Xp": .Cells(1, C + 3) = "ª÷ÃB": .Cells(R + 2, 1) = "¦Xp"
 '¡ô¥OWith½d³òªºÀx¦s®æ²Ä1¦C(CÅܼÆ+2)ÄæÀx¦s®æÈ¬O "¦Xp" ¦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 "¦Xp" ¦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ª¾ÃÑ!ÁÂÁÂ
 | 
 |