FAlonso

§Ú°µ¤F¤@­Ó§¹¾ãªºµ{¦¡,¼Ó¥D¥i¥H¸Õ¸Õ,¤j®a¤]¥iµ¹·N¨£
¼g±o¯uºC,40´X¦æªá¤F¤@¤Ñ®É¶¡

Hsieh

§¹¥þ¬Ý¤£À´©pÅÞ¿è
½Ð±N¶·¨D±Ô­z²M·¡¡A¹ê¦bµLªk±q§A¿ù»~ªº¥N½X¡A§ä¥X§AªºÅÞ¿è

FAlonso

1. Sub abc()
   
2. Dim myrange As Range, mystring(), count()
   
3. Dim i, j, k As Integer
   
4. Set myrange = Range("A1:D" & Range("A1").End(xlDown).Row)   '­pºâ¦r¥À¦êªºÁ`½d³ò
   
5. i = myrange.Cells.count / 4        '­pºâ¦r¥À¦êªº¦C¼Æ
   
6. 
   
7. ReDim mystring(i)          '§âmystringªºarray½Õ¸û¦Ü¦r¥À¦ê¦C¼Æ
   
8. ReDim count(i)             '¨C¤@­Ó¦r¥À¦ê§¡³]¦³¤@­Ó­p¼Æ¾¹
   
9. 
   
10. For j = 1 To i
    
11. count(j) = 1   '¨C­Ó¦r¦ê§¡¥X²{¤@¦¸,©Ò¥H³]­p¼Æ¾¹¬°1
    
12. Next
    
13. 
    
14. For j = 1 To i      
    
15. For k = 1 To 4
    
16. mystring(j) = mystring(j) + myrange.Cells(j, k)   '§â¦r¦ê¿é¤Jmystring
    
17. Next   '¦pmystring(1)¬OASDF,mystring(2)¬OASSS (½Ð°Ñ¦Ò¼Ó¥Dexcelªº¦r¥À)
    
18. Next
    
19. 
    
20. For j = 1 To i - 1
    
21. For k = j + 1 To i
    
22. 
    
23. If count(j) = 0 Then
    
24. Exit For                      '­p¼Æ¾¹¬°0,§Y­«ÂЦr¥À§R±¼,¤£»Ý¦AÀˬd
    
25. End If
    
26. 
    
27. If mystring(j) = mystring(k) Then     '¤ñ¸ûmystring array¤¤ªº¦r¥À¦ê
    
28. mystring(k) = vbnullstring   '§â­«ÂЪº¦r¥À·F±¼
    
29. count(j) = count(j) + 1      '¬Û¦Pªº¸Ü,­p¼Æ¾¹¥[1
    
30. count(k)=0   '±N­«ÂЪº¦r¥Àªº­p¼Æ¾¹µ¹Ãö±¼
    
31. End If  
    
32. Next                                                
    
33. Next     
    
34. 
    
35. Range("H1").Select
    
36. For j = 1 To i
    
37. If mystring(j) <> vbNullString Then       '¤£¬Ovbnullstring«K§Û¿ý¦bHÄæ
    
38. ActiveCell.Value = Cells(j, 1)
    
39. ActiveCell.Offset(, 1).Value = Cells(j, 2)
    
40. ActiveCell.Offset(, 2).Value = Cells(j, 3)
    
41. ActiveCell.Offset(, 3).Value = Cells(j, 4)
    
42. ActiveCell.Offset(, 4).Value = count(j)
    
43. ActiveCell.Offset(1).Activate
    
44. End If
    
45. Next
    
46. 
    
47. End Sub

½Æ»s¥N½X

§Æ±æ°ª¤âµûµû§Ú³o­Ómacro

Hsieh

¦^´_ 6# basarasy


    ÄÀ©ñª«¥ó¬O¦n²ßºD
¨ä¹êª«¥ó·|ÀHµÛµ{§Çµ²§ô¦Ó¦Û°ÊÄÀ©ñ

asus103

¦^´_ 4# Hsieh
½Ð°Ý
mystr = Join(Application.Transpose(Application.Transpose(A.Resize(, 4))), ",")
µ{¦¡½X¤¤¨â¦¸Transposeªº·N¸q¬O§_¬O­n±N1~4Ä檺¤º®e¥©§®ªºÂন°}¦C¡A¦ÓµL»Ý¨Ï¥ÎFOR°j°é¡A¥H«KJOIN¦¨¤@¦r¦ê?

¬ãŪ¶W¯Åª©¥Dªºµ{¦¡½XÁ`·|¦³¥O¤HÅåÆAªºsurprise

Hsieh

¦^´_ 6# FAlonso

http://forum.twbts.com/thread-20-1-1.html
http://forum.twbts.com/viewthread.php?tid=2287&extra=pageD1&page=2
³o¸Ì¦³ªì¨Bªº»¡©ú¡A­n¤F¸Ñ¨äÄݩʤΤèªk½Ð°Ñ¾\VBA»¡©úÀÉ

basarasy

¦^´_ 4# Hsieh

ÁÂÁ¤j¤j
¬Ý§¹¤j¤jªº»¡©ú¥H©ú¥Õ¤Ö¤Ö.
¦]¬°ÁÙ¥¼¾Ç²ß¨ì  ³]¸m¦r¨åª«¥ó,°}¦C ªº¥Îªk.
ÁÙ¦³´N¬O  ¬O§_set°µª«¥ó ªºÅܼÆ,³Ì«á³£­nset Nothing?

FAlonso

³o­Ódictionary¨s³º¬O¤°»òªF¦è? ¦³¤°»ò§@¥Î? ·Pı«Ü¯«¯µ,¤@¯ëvba®Ñ³£¥¼¥²´£¤Î

Hsieh

¦^´_ 3# basarasy
³o¬O«Üª½Æ[ªº¥N½X

1. Sub Ex()
   
2. Dim A As Range  '«Å§iÅܼƬ°Àx¦s®æ«¬ºA
   
3. Set d = CreateObject("Scripting.Dictionary")  '³]¸m¦r¨åª«¥ó
   
4. Set d1 = CreateObject("Scripting.Dictionary")  '³]¸m¦r¨åª«¥ó
   
5. For Each A In Range([A1], [A1].End(xlDown))  '¦bAÄæ§@°j°é¨ú±o¦ì¸m
   
6. mystr = Join(Application.Transpose(Application.Transpose(A.Resize(, 4))), ",")  'Åܼƫü©w¬°AÄæ¦V¥kÂX®i¦¨4Äæ¤j¤pªº½d³ò¥H³r¸¹³sµ²ªº¦r¦ê
   
7. d(mystr) = d(mystr) + A.Offset(, 4).Value  '­pºâ¥Hmystr¬°ÃöÁä¦rªº²Ö¥[
   
8. d1(mystr) = Array(A.Value, A.Offset(, 1).Value, A.Offset(, 2).Value, A.Offset(, 3).Value, d(mystr))  '¥Hmystr¬°ÃöÁä¦r¥[¤J¶µ¥Ø¡A¦¹¶µ¥Ø¬°¤@°}¦C¡A°}¦C³Ì«á¤@­Ó­È¬°²Ö¥[­È
   
9. Next
   
10. [H:L] = ""  '²MªÅ¥Ø¼Ð°Ï
    
11. [H1].Resize(d1.Count, 5) = Application.Transpose(Application.Transpose(d1.items))  '±N¦r¨åª«¥ó¤º®e¥H2¦¸Âà¸m(¦]¬°­nÂন¼Ð·Çªº¤Gºû°}¦C)¼g¤J¥Ø¼Ð°Ï
    
12. End Sub

½Æ»s¥N½X

basarasy

¦^´_ 2# Hsieh

·PÁÂHsieh¤j¤j.
¤j¤j¥Îªº½X«Ü²`><,«Ü¦h³£¨S¦³¨£¹L.
½Ð°ÝHsieh¤j¤j¥i¥H¸Ñ»¡¶Ü?