- ©«¤l
- 1447
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1471
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-12-5
|
ÁÂÁ½׾Â
¤µ¤Ñ¦Û¤vµù¸Ñµ{¦¡½X½èºÃ¤F¦Û¤v¬O§_¯uÀ´¨CÓ³¯z.²[¦¡...,ÁÙ¬O¥u·|§Ûŧ
item() :·|¨Ì¦ì¸m©Î«öÁä¶Ç¦^ ¶°¦X ª«¥óªº¯S©w ¦¨û¡C
https://learn.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/item-method-visual-basic-for-applications
¥H¤U¬O#6¼Óªº¤ß±oµù¸Ñ
Option Explicit
Sub TEST_±Æ°£¸ê®Æªí«½Æ¦C_ª½¦¡±è¦¸¦W³æ_¥ý¾ã²z¦A±Æ§Ç()
Dim Brr, Crr, xR, Z, xA, V, W, P, Sh1, SH3
'¡ô«Å§i³q¥Î«¬ÅܼÆ
Dim i&, j&, S&, N&, R&, C&, X&, Y&, Q&
'¡ô«Å§iªø¾ã¼ÆÅܼÆ
Dim D As Date, Da$, T$
'¡ô«Å§iÅܼÆ!(D)¬O¤é´ÁÅܼÆ,(Da,T)¬O¦r¦êÅܼÆ
Set W = CreateObject("Scripting.Dictionary")
Set Z = CreateObject("Scripting.Dictionary")
Set P = CreateObject("Scripting.Dictionary")
'¡ô¥OW,Z,P¦U¬O¦r¨å
Set Sh1 = Sheets("Sheet1")
'¡ô¥OSh1¬O "Sheet1" ¤u§@ªí
Set SH3 = Sheets("Sheet3")
'¡ô¥OSh1¬O "Sheet3" ¤u§@ªí
SH3.UsedRange.Clear
'¡ô¥O "Sheet3" ¤u§@ªí²[»\¦³¨Ï¥ÎªºÀx¦s®æ³Ì¤p¤è¥¿°Ï°ì²M°£
Crr = Range(Sh1.[A1], Sh1.UsedRange).Offset(1, 0)
'¡ô¥OCrr¬O ªí1[A1]¨ì¦³¨Ï¥ÎÀx¦s®æªº³Ì¤p¤è¥¿½d³òÀx¦s®æ©¹¤U°¾²¾1¦C½d³òªºÈ
R = UBound(Crr) - 1
'¡ô¥OR¬O Crr°}¦CÁa¦V³Ì¤j¦C¸¹¼Æ´î 1
C = UBound(Crr, 2)
'¡ô¥OC¬O Crr°}¦C¾î¦V³Ì¤j¦C¸¹¼Æ
ReDim Brr(1 To R, 1 To C)
'¡ô«Å§iBrr°}¦C½d³ò!Áa¦V±q1¨ìR,¾î¦V±q1¨ìC
ReDim V(R - 1)
'¡ô«Å§iV¬O¤@ºû°}¦C!¯Á¤Þ½d³ò±q0¨ìR - 1
For i = 1 To R
'¡ô³]¥~¶¶°j°é!i±q1¨ìR
Da = ""
'¡ô¥ODa¦r¦êÅܼƬOªÅ¦r¤¸
For j = 1 To C
'¡ô³]¤º¶¶°j°é!j±q1¨ìC
Da = Da & "/" & Crr(i, j)
'¡ô¥ODa¦r¦êÅܼƬO ¦Û¤v³s±µ"/"²Å¸¹,¦A³s±µi°j°é¦Cj°j°éÄ檺Crr°}¦CÈ
Next
If W.Exists(Da) = Empty Then
'¡ô¦pªG¥HDa·íkey¬d¹îW¦r¨å¸Ì¬Oªì©lÈ
Q = Q + 1
'¡ô¥OQÅܼƲ֥[1
For j = 1 To C
'¡ô³]¤º¶¶°j°é!j±q1¨ìC
Brr(Q, j) = Trim(Crr(i, j))
'¡ô¥OQÅܼƦC²Äj°j°éÄ檺Brr°}¦CȬO i°j°é¦C²Ä°j°éjÄ檺ȥh±¼ÀY§ÀªºªÅ¥Õ¦r¤¸
Next
W(Da) = ""
'¡ô¥O¥HDa¦r¦êÅܼÆÈ·íkey,item¬OªÅ¦r¤¸Ë¤JW¦r¨å¸Ì
End If
Next
W.RemoveAll
'¡ô²MªÅW¦r¨å
For Each xR In Brr
'¡ô³]¶¶°j°é!¥OxR ¬OBrr°}¦Cªº¤@û
If InStr(xR, "(") Then
'¡ô¦pªGxRȸ̦³¥]§t"("²Å¸¹?
S = InStr(xR, "±è") + 1
'¡ô¥OS¬OxR§PÂ_ "±è"¦r¤¸©Ò¦b¦r¤¸¦ì¸m¼Æ
N = InStr(xR, "(")
'¡ô¥ON ¬O xR§PÂ_ "("¦r¤¸©Ò¦b¦r¤¸¦ì¸m¼Æ
D = Mid(xR, S, N - S)
'¡ô¥OD¬O xRȱqS¦r¤¸¶}©l¨ú N - SÓ¦rªº¦r¦ê¦AÅܬ°¤é´Á
W(D) = xR
'¡ô¥OD³o¤é´Á·íkey,item¬OxRªºÈ
P(xR) = D
'¡ô¥OxR³o¤é´Á·íkey,item¬ODªºÈ
End If
Next
For Each xA In W.KEYS
'¡ô³]¶¶°j°é!¥OxA ¬OW¦r¨å¸Ìkeysªº¤@û
Z(xA) = V
'¡ô¥O¥HxA¬°key,item¬OV¤@ºû°}¦C,ˤJZ¦r¨å¸Ì
Next
For i = 1 To Q
'¡ô³]¥~¶¶°j°é!i±q1¨ìQ
For j = 2 To C
'¡ô³]¤º¶¶°j°é!j±q1¨ìQ
T = Brr(i, j)
'¡ô¥OT¦r¦êÅܼƬOi°j°é¦Cj°j°éÄ檺Brr°}¦CÈ
If T <> "" Then
'¡ô¦pªGT¦r¦êÅܼƤ£µ¥©óªÅ¦r¤¸??
V = Z(P(T))
'¡ô¥OV³o³q¥Î«¬ÅܼƬO ¥HT¦r¦ê¬d¹îP¦r¨åªºitemȦA¬d¹îZ¦r¨å±o¨ìªºitem(¤@ºû°}¦C)
X = W(T & "|") + 1
'¡ô¥OX³o¼Æ¦rÅܼƬO ¥HT¦r¦ê³s±µ"|"²Å¸¹¬d¹î¦r¨åªºitemȲ֥[ 1
V(X - 1) = Brr(i, 1)
'¡ô¥OV³o¤@ºû°}¦Cªº¯Á¤Þ¸¹¬O X-1ªº¤¸¯À¬O ¬Oi°j°é¦C²Ä¤@Ä檺Brr°}¦CÈ
W(T & "|") = X
'¡ô¥O¥HT¦r¦ê³s±µ"|"²Å¸¹¬°keyªºitem¬O ¼Æ¦rÅܼÆX
Z(P(T)) = V
'¡ô¥O¥HT¦r¦ê¬d¹îP¦r¨åªºitemȦA¬d¹îZ¦r¨å±o¨ìªºitem¬O ¤@ºû°}¦CV
End If
Next j
Next i
SH3.[A1].Resize(1, Z.Count) = Application.Transpose(Application.Transpose(Z.KEYS))
'¡ô¥Oªí¤T[A1]ÂX®i¦V¤UÂX®i1¦C(A1¦Û¨¦C),¦V¥kÂX®iZ¦r¨åÁä¼ÆÄæ¬O Z¦r¨åkeyÂà¸m¨â¦¸ªºÈ
SH3.[A2].Resize(Q, Z.Count) = Application.Transpose(Z.ITEMS)
'¡ô¥Oªí¤T[A2]ÂX®i¦V¤UÂX®i Q¦C,¦V¥kÂX®iZ¦r¨åÁä¼ÆÄæ¬O Z¦r¨åkeyÂà¸m¨â¦¸ªºÈ
For i = 1 To SH3.UsedRange.Columns.Count
'¡ô³]¶¶°j°é!i±q1¨ì ªí¤T¨Ï¥Î½d³òªºÄæ¼Æ
With Range(SH3.Cells(1, i), SH3.Cells(Rows.Count, i).End(3))
'¡ô¥H¤U¬O¦³Ãö©óªí¤T ¨C¤@Ä榳¤º®eªºÀx¦s®æµ{§Ç
.Sort KEY1:=.Item(1), Order1:=1, Header:=2, Orientation:=xlTopToBottom
'¡ô±Æ§Ç:°ò·Ç¬O½d³ò¸Ì²Ä¤@®æÄæ¦ì,¤j¨ì¤p,¨S¦³¼ÐÃD¦C,Áa¦V±Æ§Ç±q¤W¨ì¤U
End With
Next
With SH3.UsedRange
'¡ô¥H¤U¬O¦³Ãö©óªí¤T¨Ï¥Î½d³òªºÀx¦s®æµ{§Ç
.Sort KEY1:=.Item(1), Order1:=1, Header:=2, Orientation:=xlLeftToRight
'¡ô±Æ§Ç:°ò·Ç¬O½d³ò¸Ì²Ä¤@®æ¦C¦ì,¤j¨ì¤p,¨S¦³¼ÐÃD¦C,Áa¦V±Æ§Ç±q¥ª¨ì¥k
For i = 1 To .Columns.Count
'¡ô³]¶¶°j°é!i±q1 ¨ìªí¤T¨Ï¥Î½d³òªºÄæ¼Æ
D = .Cells(1, i)
'¡ô¥OD¤é´ÁÅܼƬO ªí¤T¨Ï¥Î½d³òªº¬Û¹ïÀx¦s®æ²Ä1¦C²Äi°j°éÅܼÆÄ檺ÈÂন¤é´Á
.Cells(1, i) = W(D)
'¡ô¥O¥H ªí¤T¨Ï¥Î½d³òªº¬Û¹ïÀx¦s®æ²Ä1¦C²Äi°j°éÅܼÆÄ檺Ȭd¹îW¦r¨å±o¨ìªºitemÈ(¦r¦ê)
'ªºÈ©ñ¤J·í®æ
Next
End With
Application.Goto [Sheet3!A1]
Set Crr = Nothing
Set Brr = Nothing
Set W = Nothing
Set Z = Nothing
Set P = Nothing
End Sub
Sub Itemªº³W«h()
Dim Area As Range
Set Area = [A1:J10]
MsgBox Area.Item(1).Address
MsgBox Area.Item(5).Address
MsgBox Area.Item(10).Address
MsgBox Area.Item(11).Address
MsgBox Area.Item(100).Address
MsgBox Area.Item(101).Address
'¡ô½d³ò¤º¥Ñ¥ª¨ì¥k,¤W¨ì¤U¼ÐÀx¦s®æ¯Á¤Þ
MsgBox Area.Item(1, 1).Address
MsgBox Area.Item(1, 5).Address
MsgBox Area.Item(1, 10).Address
MsgBox Area.Item(2, 1).Address
MsgBox Area.Item(10, 10).Address
MsgBox Area.Item(1, 11).Address
'¡ô½d³ò¤ºªº®y¼Ð¤è¦¡¼ÐÀx¦s®æ¯Á¤Þ
End Sub |
|