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

[µo°Ý] Àˬd­«½Æ©Ê½èªº¸ê®Æ

¦^´_ 20# GBKEE
²×©ó§ä¨ì°ÝÃD¼xµ²ÂI¤F¡C ·í°õ¦æ§¹«á
  1. For Each E In Sheet1.Range("A1").CurrentRegion.Rows
  2.     D(E.Cells(1, 1) & E.Cells(1, 2) & E.Cells(1, 3) & E.Cells(1, 5)) = E.Value
  3. Next
½Æ»s¥N½X
D.KEYS °}¦C­È¤º®eÀ³¸Ó¦@¦³¤»­Ó¡A§Y¡G
  1. '  D.KEYS :  : Variant/Variant(0 to 5) : ThisWorkbook.ex
  2. '  D.KEYS(0) : "©m¦W¦a°Ï©Ê§O±B«Ã" : Variant/String : ThisWorkbook.ex
  3. '  D.KEYS(1) : "¤p§õ¥x¥_¤k¤w±B" : Variant/String : ThisWorkbook.ex
  4. '  D.KEYS(2) : "¤p¼B®ç¶é¨k¤w±B" : Variant/String : ThisWorkbook.ex
  5. '  D.KEYS(3) : "¤p³¯·s¦Ë¤k¥¼±B" : Variant/String : ThisWorkbook.ex
  6. '  D.KEYS(4) : "¤p±i¤¤Ãc¤k¥¼±B" : Variant/String : ThisWorkbook.ex
  7. '  D.KEYS(5) : "¤p´ö¥x¤¤¨k¤w±B " : Variant/String : ThisWorkbook.ex
½Æ»s¥N½X
¦¹®É¡A«h°õ¦æ¤@¤Á¶¶§Q¡C ¤Ï¤§¡A·í³B²z°}¦Cµ²ªG¬°¤U¦C±¡ªp®É¡G
  1. '  D.KEYS :  : Variant/Variant(0 to 8) : ThisWorkbook.ex
  2. '  D.KEYS(0) : "©m¦W¦a°Ï©Ê§O±B«Ã" : Variant/String : ThisWorkbook.ex
  3. '  D.KEYS(1) : "¤p§õ¥x¥_¤k¤w±B" : Variant/String : ThisWorkbook.ex
  4. '  D.KEYS(2) : "¤p¼B®ç¶é¨k¤w±B" : Variant/String : ThisWorkbook.ex
  5. '  D.KEYS(3) : 0 : Variant/Integer : ThisWorkbook.ex
  6. '  D.KEYS(4) : 1 : Variant/Integer : ThisWorkbook.ex
  7. '  D.KEYS(5) : 2 : Variant/Integer : ThisWorkbook.ex
  8. '  D.KEYS(6) : "¤p³¯·s¦Ë¤k¥¼±B" : Variant/String : ThisWorkbook.ex
  9. '  D.KEYS(7) : "¤p±i¤¤Ãc¤k¥¼±B" : Variant/String : ThisWorkbook.ex
  10. '  D.KEYS(8) : "¤p´ö¥x¤¤¨k¤w±B " : Variant/String : ThisWorkbook.ex
½Æ»s¥N½X
¤W«Ò¡B¦ò¯ª°Ú¡I
·í³ò°é°õ¦æ¨ì D.KEYS(3)¡BD.KEYS(4)¡BD.KEYS(5) ´N¤¤¼Ö³z¤F¡C
³oªí¥Ü¦b
  1. For Each E In Sheet1.Range("A1").CurrentRegion.Rows
  2.     D(E.Cells(1, 1) & E.Cells(1, 2) & E.Cells(1, 3) & E.Cells(1, 5)) = E.Value
  3. Next
½Æ»s¥N½X
³B¸Ì¶¥¬q¥X¤F°ÝÃD¡C À³¸Ó±N­«½Æ­È¤©¥H¹LÂo½Õ¡C

TOP

¥»©«³Ì«á¥Ñ c_c_lai ©ó 2013-7-25 10:02 ½s¿è

¦^´_ 20# GBKEE
±z¥Ø«e¬Ý¨ìªº E ©ÎªÌ¬O E As Variant ³£¤w¦h¤è´ú¸Õ¹L¡A
·í®É E ¬°¦ó­×§ï¦¨ ©ú½T«Å§i¥ç¬O¦¹¥Ñ¨Ó¡C
¥Ø«e¥uµ¥«Ý jackyliu ªº´ú¸Õµ²ªG¤F¡A
§Ú·Q·¥¦³¥i¯à¯uªº¬O Assign ªº°ÝÃD¡A
¦]¬°°ÝÃDµo¥Í®É§Ú¦³Ãö¬d¨ì
  1.         For Each E In Dk.KEYS
  2.             '  E ¶Ç¤J­È¬° "µL"¡A ¥H­Pµo¥Í¥H¤U©µ¥Íªº "«¬ºA¤£²Å" ¿ù»~°T®§
  3.             .Cells(cts, "A").Resize(1, UBound(Dk(E), 2)).Value = Dk(E)   '  Åª¨ú¦r¨åª«¥óªº ITEM (°}¦C)
½Æ»s¥N½X

TOP

¦^´_ 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´ú¸Õ¬Ý
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 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.     With Sheet1
  6.         For Each a In .Range(.[A1], .[A1].End(xlDown))
  7.             mystr = a & a.Offset(, 1) & a.Offset(, 2) & a.Offset(, 4)
  8.             '  If d.exists(mystr) Then MsgBox a & "¸ê®Æ­«½Æ"
  9.             d(mystr) = Application.Transpose(Application.Transpose(a.Resize(, 6).Value))
  10.         Next
  11.     End With
  12.    
  13.     With Sheet2
  14.         .Cells.ClearContents
  15.         .[A1].Resize(d.Count, 6) = Application.Transpose(Application.Transpose(d.items))
  16.     End With
  17. End Sub
½Æ»s¥N½X

TOP

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

TOP

¦^´_ 16# jackyliu
§Ú¥u¦³2003ª©°õ¦æ¤@ª½¦n¦nªº, µLªk¬d¥X§Aªº¿ù»~¦b­þ¸Ì.
c_c_lai ¤]À°¦£´ú¸Õ¨ä¥Lª©¥»¦³®É·|¦³¿ù»~.(¤£¤F¸Ñ¬°¦ó¦p¦¹)
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

ª©¤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)

TOP

¦^´_ 14# jackyliu
Hsieh¶Wª© 13# ªº¸Õ¤F,¨S¦p¨S¿ù»~¥i·ÓµÛ§ï¸Õ¸Õ¬Ý
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

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

«¬ºA¤£²Å.jpg (31.33 KB)

«¬ºA¤£²Å

«¬ºA¤£²Å.jpg

TOP

  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
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

        ÀR«ä¦Û¦b : ·O´d¨S¦³¼Ä¤H¡A´¼¼z¤£°_·Ð´o¡C
ªð¦^¦Cªí ¤W¤@¥DÃD