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