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

[µo°Ý] ¦p¦ó¥[¸ê®Æ

[µo°Ý] ¦p¦ó¥[¸ê®Æ

½Ð°Ý¤j¤j¦³¤èªk¥i¥H¦b¦P¤@¦a¤è§âA,B,C,D ¤@¼Ë¸ê®ÆªºE¥[°_¨Ó¶Ü?

BOOK1.rar (7.42 KB)

50 ¦r¸`¥H¤º
¤£¤ä«ù¦Û©w¸q Discuz! ¥N½X

¦^´_ 1# basarasy
  1. Sub Ex()
  2. Dim A As Range
  3. Set d = CreateObject("Scripting.Dictionary")
  4. Set d1 = CreateObject("Scripting.Dictionary")
  5. For Each A In Range([A1], [A1].End(xlDown))
  6. mystr = Join(Application.Transpose(Application.Transpose(A.Resize(, 4))), ",")
  7. d(mystr) = d(mystr) + A.Offset(, 4).Value
  8. d1(mystr) = Array(A.Value, A.Offset(, 1).Value, A.Offset(, 2).Value, A.Offset(, 3).Value, d(mystr))
  9. Next
  10. [H:L] = ""
  11. [H1].Resize(d1.Count, 5) = Application.Transpose(Application.Transpose(d1.items))
  12. End Sub
½Æ»s¥N½X
¦pªG§âªí®æ¥[¤WÄæ¦WºÙ¡A´N¥i¨Ï¥Î¼Ï¯Ã¤ÀªR
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦^´_ 2# Hsieh

·PÁÂHsieh¤j¤j.
¤j¤j¥Îªº½X«Ü²`><,«Ü¦h³£¨S¦³¨£¹L.
½Ð°ÝHsieh¤j¤j¥i¥H¸Ñ»¡¶Ü?
50 ¦r¸`¥H¤º
¤£¤ä«ù¦Û©w¸q Discuz! ¥N½X

TOP

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

TOP

¦^´_ 4# Hsieh

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

TOP

³o­Ódictionary¨s³º¬O¤°»òªF¦è? ¦³¤°»ò§@¥Î? ·Pı«Ü¯«¯µ,¤@¯ëvba®Ñ³£¥¼¥²´£¤Î
80 ¦r¸`¥H¤º
¤£¤ä«ù¦Û©w¸q Discuz! ¥N½X

TOP

¥»©«³Ì«á¥Ñ Hsieh ©ó 2011-1-3 23:35 ½s¿è

¦^´_ 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»¡©úÀÉ
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦^´_ 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
ASUS

TOP

¦^´_ 6# basarasy


    ÄÀ©ñª«¥ó¬O¦n²ßºD
¨ä¹êª«¥ó·|ÀHµÛµ{§Çµ²§ô¦Ó¦Û°ÊÄÀ©ñ
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¥»©«³Ì«á¥Ñ FAlonso ©ó 2011-1-4 20:26 ½s¿è
  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. ReDim mystring(i)          '§âmystringªºarray½Õ¸û¦Ü¦r¥À¦ê¦C¼Æ
  7. ReDim count(i)             '¨C¤@­Ó¦r¥À¦ê§¡³]¦³¤@­Ó­p¼Æ¾¹

  8. For j = 1 To i
  9. count(j) = 1   '¨C­Ó¦r¦ê§¡¥X²{¤@¦¸,©Ò¥H³]­p¼Æ¾¹¬°1
  10. Next

  11. For j = 1 To i      
  12. For k = 1 To 4
  13. mystring(j) = mystring(j) + myrange.Cells(j, k)   '§â¦r¦ê¿é¤Jmystring
  14. Next   '¦pmystring(1)¬OASDF,mystring(2)¬OASSS (½Ð°Ñ¦Ò¼Ó¥Dexcelªº¦r¥À)
  15. Next

  16. For j = 1 To i - 1
  17. For k = j + 1 To i

  18. If count(j) = 0 Then
  19. Exit For                      '­p¼Æ¾¹¬°0,§Y­«ÂЦr¥À§R±¼,¤£»Ý¦AÀˬd
  20. End If

  21. If mystring(j) = mystring(k) Then     '¤ñ¸ûmystring array¤¤ªº¦r¥À¦ê
  22. mystring(k) = vbnullstring   '§â­«ÂЪº¦r¥À·F±¼
  23. count(j) = count(j) + 1      '¬Û¦Pªº¸Ü,­p¼Æ¾¹¥[1
  24. count(k)=0   '±N­«ÂЪº¦r¥Àªº­p¼Æ¾¹µ¹Ãö±¼
  25. End If  
  26. Next                                                
  27. Next     

  28. Range("H1").Select
  29. For j = 1 To i
  30. If mystring(j) <> vbNullString Then       '¤£¬Ovbnullstring«K§Û¿ý¦bHÄæ
  31. ActiveCell.Value = Cells(j, 1)
  32. ActiveCell.Offset(, 1).Value = Cells(j, 2)
  33. ActiveCell.Offset(, 2).Value = Cells(j, 3)
  34. ActiveCell.Offset(, 3).Value = Cells(j, 4)
  35. ActiveCell.Offset(, 4).Value = count(j)
  36. ActiveCell.Offset(1).Activate
  37. End If
  38. Next

  39. End Sub
½Æ»s¥N½X
§Æ±æ°ª¤âµûµû§Ú³o­Ómacro
80 ¦r¸`¥H¤º
¤£¤ä«ù¦Û©w¸q Discuz! ¥N½X

TOP

        ÀR«ä¦Û¦b : ¤H¨ÆªºÁ}Ãø»PµZ¿i¡A´N¬O¤@ºØ¦ÒÅç¡C
ªð¦^¦Cªí ¤W¤@¥DÃD