c_c_lai

¦^´_ 10# GBKEE
³o¤@©Û¤]¦­´N¸Õ¹L¤F¡AµL®Ä¡I
§ÚÆ[¹î¹L¬O D.KEYS ±a­ÈÂà¤J®Éªº¦s­È°ÝÃD¡C
¥ç§Yµo¥Í¦b For Each E In D.KEYS ªº¤§«e¡C
¥Ø«e«ç»ò´ú¤]³£§ä¤£¥X¡AÆZÆF²§ªº¡C

GBKEE

¦^´_ 11# c_c_lai
ÁÂÁ§A,§A¤w¾¨¥þ¤O,²ö¥i­@¦ó¥¦¤F

Hsieh

1. Sub ex()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. With ¤u§@ªí1
   
4.    For Each a In .Range(.[A1], .[A1].End(xlDown))
   
5.       mystr = a & a.Offset(, 1) & a.Offset(, 2) & a.Offset(, 4)
   
6.       If d.exists(mystr) Then MsgBox a & "¸ê®Æ­«½Æ"
   
7.       d(mystr) = Application.Transpose(Application.Transpose(a.Resize(, 6).Value))
   
8.    Next
   
9. End With
   
10. With ¤u§@ªí2
    
11. .Cells.ClearContents
    
12. .[A1].Resize(d.Count, 6) = Application.Transpose(Application.Transpose(d.items))
    
13. End With
    
14. End Sub

½Æ»s¥N½X

¦^´_ 5# jackyliu

jackyliu

ª©¤j :
¤@¼Ë¬O °õ¦æ¶¥¬q¿ù»~'13'«¬ºA¤£²Å
®É¥i¥H¦³®É¦³¿ù»~,¬O¤£±µ¨ü³o¼Ëªº¼gªk¶Ü?
¤£ª¾¹D¬O­þ¥X¤F°ÝÃD ?

GBKEE

¦^´_ 14# jackyliu
Hsieh¶Wª© 13# ªº¸Õ¤F,¨S¦p¨S¿ù»~¥i·ÓµÛ§ï¸Õ¸Õ¬Ý

jackyliu

ª©¤j:
       µ{¦¡½X´«¤W³Ì«áª©, ¤@¼Ë·|¥X²{ ---> °õ¦æ¶¥¬q¿ù»~'13' «¬ºA¤£²Å
µ{¦¡°»¿ù°±º¢¦b §ó·sªº¨º¬q, ¬Ý¤£¥X¨Ó¬O¤°»ò°ÝÃD, ª©¤j¥i¥HÀ°¦£¤@¤U¶Ü?

     .Cells(I, "A").Resize(1, UBound(D(K), 2)) = D(K)

GBKEE

¦^´_ 16# jackyliu
§Ú¥u¦³2003ª©°õ¦æ¤@ª½¦n¦nªº, µLªk¬d¥X§Aªº¿ù»~¦b­þ¸Ì.
c_c_lai ¤]À°¦£´ú¸Õ¨ä¥Lª©¥»¦³®É·|¦³¿ù»~.(¤£¤F¸Ñ¬°¦ó¦p¦¹)

c_c_lai

¦^´_ 16# jackyliu
³o¬O¸g¹L§Ú´ú¸Õ¹L OK ªº¡AÁöµM¤º®e¤j­P¤@¼Ë¡A
¦ýÁÙ¬O¨Ï¥Î§Úªºµ{¦¡½X¸Õ¸Õ¬Ý¡C
(¤§«e§Ú¥ç´ú¥X§A©Ò»¡ªºª¬ªp¡A¸Õ¸Õ³o°¦¬Ý¬Ý¡A¨ä¤¤¤]±N Debug ªº¹Lµ{¤º®e¥ç¨Ö§@¦¨µùÄÀ)

1. Option Explicit
   
2. 
   
3. Sub Ex()
   
4.     Dim Dk As Object, E As Variant, cts As Integer
   
5.     '  Dim Dk As Object, E, cts As Integer
   
6.    
   
7.     Set Dk = CreateObject("Scripting.dictionary")         '  ¦r¨åª«¥ó
   
8.    
   
9.     '  1. ±N Sheet1 ªº¸ê®Æ,½Æ»s¨ì Sheet2 ªº A1 ¦ì¸m¶}©l,¨Ì§Ç¼g¤J.
   
10.     '  2. ­«½Æ©Êªº¸ê®Æ,¤£­n¦A­«½Æ½Æ»s¨ìSheet2
    
11.     '  3. ¤ñ¸û¤£¥i­«½ÆÄæ¦ì:©m¦W,¦a°Ï,©Ê§O,±B«Ã
    
12.     For Each E In Sheet1.Range("A1").CurrentRegion.Rows  '  ª«¥ó: A1 ©Ò©µ¦ù½d³òªº¦C
    
13.         '  E.Value : Variant/Variant(1 to 1, 1 to 6) : ThisWorkbook.Ex
    
14.         '  E.Value(1,1) : "©m¦W" : Variant/String : ThisWorkbook.Ex2
    
15.         '  E.Value(1,2) : "¦a°Ï" : Variant/String : ThisWorkbook.Ex2
    
16.         '  E.Value(1,3) : "©Ê§O" : Variant/String : ThisWorkbook.Ex2
    
17.         '  E.Value(1,4) : "±Ð¨|µ{«×" : Variant/String : ThisWorkbook.Ex2
    
18.         '  E.Value(1,5) : "±B«Ã" : Variant/String : ThisWorkbook.Ex2
    
19.         '  E.Value(1,6) : "¤l¤k" : Variant/String : ThisWorkbook.Ex2
    
20.         Dk(E.Cells(1, 1) & E.Cells(1, 2) & E.Cells(1, 3) & E.Cells(1, 5)) = E.Value
    
21.     Next
    
22.    
    
23.     With Sheet2
    
24.         .Cells.Clear
    
25.         cts = 1
    
26.         For Each E In Dk.KEYS
    
27.             '  UBound(Dk(E), 1) : 1 : Long : ThisWorkbook.Ex
    
28.             '  UBound(Dk(E), 2) : 6 : Long : ThisWorkbook.Ex
    
29.             '  E : "©m¦W¦a°Ï©Ê§O±B«Ã" : Variant/String : ThisWorkbook.Ex2
    
30.             '  E : "¤p§õ¥x¥_¤k¤w±B" : Variant/String : ThisWorkbook.Ex2
    
31.             '  E : "¤p¼B®ç¶é¨k¤w±B" : Variant/String : ThisWorkbook.Ex2
    
32.             .Cells(cts, "A").Resize(1, UBound(Dk(E), 2)).Value = Dk(E)   '  Åª¨ú¦r¨åª«¥óªº ITEM (°}¦C)
    
33.         cts = cts + 1
    
34.         Next
    
35.     End With
    
36. End Sub

½Æ»s¥N½X

½Ð§â¥H¤W½Æ»sªºµ{¦¡½X©ñ¤J¨ì ThisWorkbook µ{¦¡½X°Ï¤º°õ¦æ¡C
P.S.  ¥Ø«e¦b§ÚªºÀɮפ¤ Module1 °Ï¥ç©ñ¤J¬Û¦Pµ{¦¡½X¤À§O´ú¸Õµ²ªG (Sub ¦WºÙ¤£¦P)¡A
        ³o¬O¬°¤F¤è«K´ú¸Õ "«¬ºA¤£²Å" °ÝÃD©Ò¦b¤§¬G¡C

c_c_lai

¦^´_ 16# jackyliu
¦^´_ 17# GBKEE
°ÝÃD¥i¯à¥X¦b

1. D(E.Cells(1, 1) & E.Cells(1, 2) & E.Cells(1, 3) & E.Cells(1, 5)) = E.Value

½Æ»s¥N½X

Hsieh ª©¤jÀ³¥Î¤F

1. d(mystr) = Application.Transpose(Application.Transpose(a.Resize(, 6).Value))

½Æ»s¥N½X

¦b°}¦C­È²¾Âत³z¹L   Application.Transpose()¡A¨Ï±o¼Æ­È±o¥H¥¿½T Assign¡A¨äí©w«×¤ñª½±µ
Assign ·|¨Ó±o½T¹ê¡B¸ê®Æ Assigment ¤¤¸û¤£©ö¬y¥¢¡C§Ú±N Hsieh ª©¤jªºµ{¦¡¥[¤WÅܼƫŧi¡A
¸ü©ó¦p¤U¡G

1. Sub ex()                                              '  Hsieh
   
2.     Dim d As Object, a As Range, mystr As String
   
3.    
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5. 
   
6.     With Sheet1
   
7.         For Each a In .Range(.[A1], .[A1].End(xlDown))
   
8.             mystr = a & a.Offset(, 1) & a.Offset(, 2) & a.Offset(, 4)
   
9.             '  If d.exists(mystr) Then MsgBox a & "¸ê®Æ­«½Æ"
   
10.             d(mystr) = Application.Transpose(Application.Transpose(a.Resize(, 6).Value))
    
11.         Next
    
12.     End With
    
13.    
    
14.     With Sheet2
    
15.         .Cells.ClearContents
    
16.         .[A1].Resize(d.Count, 6) = Application.Transpose(Application.Transpose(d.items))
    
17.     End With
    
18. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 19# c_c_lai
15# ¦³°Ý¨ì  Hsieh¶Wª© 13# ªº¸Õ¤F,¨S¦p¨S¿ù»~¥i·ÓµÛ§ï¸Õ¸Õ¬Ý   
§A18# µ{¦¡½X, ¥u®t§Ú¨S®Ñ©ú E As Variant

1. Dim Dk As Object, E As Variant, cts As Integer
   
2.       'Dim Dk As Object, E, cts As Integer

½Æ»s¥N½X

½Ð¦b§Úªºµ{¦¡½Xª©¥»¤¤,®Ñ©ú E As Variant ¦A´ú¸Õ¬Ý