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

[µo°Ý]±N¨â°}¦C¨Ì¶¶§Ç¦X¨Ö°ÝÃD

[ª©¥DºÞ²z¯d¨¥]
  • Hsieh(2011-1-13 23:15): 10#¤w¼Ð¥Üµù¸Ñ

Hsieh¤j¤j±z¦n
¹ï¤£°_¡A§Ú¬Ý¤£¤jÀ´
¥i¥H³Â·Ð±z¸ÑÄÀ¤@¤U¶Ü?

§Ú¦pªG­n¥Î¨ì§Úªºµ{¦¡¤¤
¬O¤£¬O­n´¡¤J1¡B3¡B5¦æ©O?
²Ä1¦æ¬O§_¤@©w±o¦b¾ã­Ó¼Ò²Õªº³Ì¤W¤è©O?
ASUS

TOP

¦^´_ 10# Hsieh
·PÁ±zHsieh¤j¤j

«D±`·P¿E±zªº¨ó§U
§Ú·Q§Ú¤j·§»Ý­nªá¤@¬q®É¶¡¨Ó®ø¤Æ³Ìªñ±z±ÐªºªF¦è

ÁÂÁ±z
ASUS

TOP

¦^´_ 1# asus103
  1. Sub merge_rank()
  2. Dim myobject As Object
  3. Dim myrange As Range
  4. Dim i As Integer

  5. Set myobject = CreateObject("scripting.dictionary")

  6. For i = 1 To 2
  7. With Worksheets("sheet" & i)
  8. For Each myrange In .Range(.[a1], .[a1].End(xlToRight))
  9. myobject(myrange.Value) = myrange.Offset(1).Value
  10. Next
  11. End With
  12. Next

  13. With Sheet3
  14. For i = 1 To myobject.Count
  15. .Cells(1, i).Value = Application.Small(myobject.keys, i)
  16. .Cells(2, i).Value = myobject.Item(Application.Small(myobject.keys, i))
  17. Next
  18. End With

  19. Set myobject = Nothing

  20. End Sub
½Æ»s¥N½X
80 ¦r¸`¥H¤º
¤£¤ä«ù¦Û©w¸q Discuz! ¥N½X

TOP

¥»©«³Ì«á¥Ñ Hsieh ©ó 2011-1-15 11:58 ½s¿è

¦^´_ 13# FAlonso
­Y¦Ò¼{¯Á¤Þ­È·|­«½Æªº±¡§Î(²Ä¤@¦C¬Û¦P¡A¦ý²Ä¤G¦C¹ïÀ³­È¤£¦P)
¦p¹Ïªº¸ê®Æ
±z·|¦p¦ó¸Ñ¨M?
Array_Sort.zip (10.21 KB)
  1. Sub Dic_Sort()
  2. Dim C()
  3. Set d = CreateObject("Scripting.Dictionary")
  4. Set d1 = CreateObject("Scripting.Dictionary")
  5. A = Sheets(1).[A1:J2]: B = Sheets(2).[A1:J2]
  6. For Each y In Array(A, B)
  7.    For i = LBound(y, 2) To UBound(y, 2)
  8.      d(y(1, i) + d1(y(1, i)) * 0.1) = Array(y(1, i), y(2, i))
  9.      d1(y(1, i)) = d1(y(1, i)) + 1
  10.    Next
  11. Next
  12. Do Until d.Count = 0
  13.    ky = Application.Small(d.keys, 1)
  14.    ReDim Preserve C(s)
  15.    C(s) = d(ky)
  16.    s = s + 1
  17.    d.Remove ky
  18. Loop
  19. Sheets(3).[A1].Resize(2, s) = Application.Transpose(C)
  20. Set d = Nothing
  21. Set d1 = Nothing
  22. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

[ª©¥DºÞ²z¯d¨¥]
  • Hsieh(2011-1-14 20:32): ¥ý´£¥X§Aªº¸Ñ¨M¤è¦¡¡A¦A¸Ñ¶}Åv­­

¦^´_ 14# Hsieh
¤U¸ü¤£¨ì
80 ¦r¸`¥H¤º
¤£¤ä«ù¦Û©w¸q Discuz! ¥N½X

TOP

¥»©«³Ì«á¥Ñ asus103 ©ó 2011-1-15 03:15 ½s¿è

¦^´_ 13# FAlonso

·PÁ±zFAlonso¤j¤j
±zªºIDEAªº½T«Ü§®¡A²`·P¨ØªA
§Ú·|®Ú¾Ú³o­Ó·Qªk¦A¨Ó¬Ý¬Ý§Úªºµ{¦¡ªº§ï¶iªÅ¶¡
§Úªº°}¦C¤¤²Ä1ºûªº½T¬O°ß¤@
¦ý¬O¨C¤@­Ó¸ê®Æ¤§¤U«o¤£¥u1­Ó
§Y
A  8 4 6               B 7 5 3 9                C 3 4 5 6 7 8 9
    3 4 5                  4 2 1 3                   1 4 2 5 4 3 3
    1 2 3                  5 4 3 2                   . . . . . . . . . ..

«D±`·PÁ±zªº¨ó§U
ASUS

TOP

[ª©¥DºÞ²z¯d¨¥]
  • Hsieh(2011-1-15 11:59): ¤w¶}©ñ¤U¸ü¡Aµ{¦¡½X¤]Åã¥Ü¤F °Ñ¦Ò¬Ý¬Ý ¦hÁ°ѻP°Q½×

¦^´_ 14# Hsieh
  1. Sub merge_rank()
  2. Dim myobject As Object, myobject2 As Object
  3. Dim myrange As Range
  4. Dim i As Integer, j As Integer

  5. Set myobject = CreateObject("scripting.dictionary")
  6. Set myobject2 = CreateObject("scripting.dictionary")

  7. With Sheet4
  8. For Each myrange In .Range(.[a1], .[a1].End(xlToRight))
  9. myobject(myrange.Value) = myobject(myrange.Value) + 1      'myrange.value¬°²Ä1 row¬Y¼Æ¦r,myobject§@¬°­p¼Æ¾¹
  10. myobject2(myrange.Value & "," & myobject(myrange.Value)) = myrange.Offset(1).Value  myobject2¿é¤J²Ä2 rowªº¼Æ¦r(index¬°myrange.Value & "," & myobject(myrange.Value,§Y¼Æ¦r¤Î¨ä¥X²{¦¸¼Æ)
  11. Next
  12. End With

  13. With Sheet5
  14. .Activate
  15. .Range("a1").Activate
  16. For i = 1 To myobject.Count   '¥ý¼Æ¦³¦h¤Öµ§¤£¦Pªº¸ê®Æ
  17. For j = 1 To myobject(Application.Small(myobject.keys, i))       '¥ý±Æ¦C,¦A§ä¥X¨ä¥X²{¦¸¼Æ
  18. ActiveCell.Value = Application.Small(myobject.keys, i)            
  19. ActiveCell.Offset(1, 0).Value = myobject2(Application.Small(myobject.keys, i) & "," & j)
  20. ActiveCell.Offset(0, 1).Select
  21. Next
  22. Next
  23. End With

  24. Set myobject = Nothing
  25. Set myobject2 = Nothing

  26. End Sub
½Æ»s¥N½X
80 ¦r¸`¥H¤º
¤£¤ä«ù¦Û©w¸q Discuz! ¥N½X

TOP

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

¦^´_ 17# FAlonso
§@ªk«ä¦ÒÅÞ¿è¤@¼Ë¡A±Æ§Ç¬O¥ÎSMALL¨ç¼Æ¡A¥i±NKEY¤@¤@²¾°£¡A¨ú³Ì¤p­È¡A©Ò¥H­Y¥ÎMIN¤]¬O¦P¼Ë®ÄªG
  1. Sub Dic_Sort()
  2. Dim C()
  3. Set d = CreateObject("Scripting.Dictionary") '
  4. Set d1 = CreateObject("Scripting.Dictionary") '¦P¯Á¤Þ¶µ¥Ø¼Æ¶q­p¼Æ¾¹
  5. A = Sheets(1).[A1:J2]: B = Sheets(2).[A1:J2] '¼g¤JA¡BB°}¦C¤º®e
  6. For Each y In Array(A, B) '¥H°j°é¶¶§ÇŪ¤JA¡BB°}¦C¨ì¦r¨åª«¥ó
  7.    For i = LBound(y, 2) To UBound(y, 2)
  8.      d(y(1, i) + d1(y(1, i)) * 0.1) = Array(y(1, i), y(2, i)) '¦]¬°¯Á¤Þ­È³£¬O¾ã¼Æ¡A©Ò¥H¯Á¤Þ­È¥[­p¼Æªº0.1­¿·í¦¨·s¯Á¤Þ­È¡AÁקK»P¨ä¥L¯Á¤Þ­È­«½Æ¡A¹ïÀ³2¦Cªº­È
  9.      d1(y(1, i)) = d1(y(1, i)) + 1 '¦P¯Á¤Þ­È­p¼Æ
  10.    Next
  11. Next
  12. Do Until d.Count = 0 '¶i¦æ°j°é¡Aª½¨ì¦r¨å¤º®e¼Æ¶q¬°0¸õ¥X°j°é
  13.    ky = Application.Small(d.keys, 1) '±o¨ì¯Á¤Þ­È°}¦C¤¤³Ì¤p­È
  14.    'ky = Application.Min(d.keys) '±o¨ì¯Á¤Þ­È°}¦C¤¤³Ì¤p­È¡A¥ç¥i¨Ï¥ÎMIN¨ç¼Æ
  15.    ReDim Preserve C(s)
  16.    C(s) = d(ky) '±N³Ì¤p­Èªº¤º®e¦s¤J°}¦C
  17.    s = s + 1
  18.    d.Remove ky '²¾°£¦r¨å¤¤³Ì¤p­Èªº¶µ¥Ø¡A¦¹®É¦r¨å¤º®e¼Æ¶q·|´î¤Ö1­Ó
  19. Loop
  20. Sheets(3).[A1].Resize(2, s) = Application.Transpose(C) '­ì¥»C°}¦C¥iµø¬°s¦C2Äæ¡A©Ò¥HÂà¸m«á¦¨¬°2¦CsÄæ¡A¼g¤J¤u§@ªí
  21. Set d = Nothing 'ÄÀ©ñª«¥ó
  22. Set d1 = Nothing 'ÄÀ©ñª«¥ó
  23. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¥»©«³Ì«á¥Ñ FAlonso ©ó 2011-1-15 14:13 ½s¿è

¬Ý²Ä20­¶,¨º­Ó¬O³Ì²×µ{¦¡
80 ¦r¸`¥H¤º
¤£¤ä«ù¦Û©w¸q Discuz! ¥N½X

TOP

  1. Sub merge_rank2()
  2. Dim myobject As Object, myobject2 As Object
  3. Dim myrange As Range
  4. Dim i As Integer, j As Integer, k As Integer, myrow As Integer
  5. Dim mykey

  6. Set myobject = CreateObject("scripting.dictionary")
  7. Set myobject2 = CreateObject("scripting.dictionary")

  8. myrow = Sheet4.Range("A65536").End(xlUp).Row

  9. With Sheet4
  10. For Each myrange In .Range(.[a1], .[a1].End(xlToRight))
  11. myobject(myrange.Value) = myobject(myrange.Value) + 1
  12. For j = 2 To myrow
  13. myobject2(myrange.Value & "," & myobject(myrange.Value) & "," & j) = myrange.Offset(j - 1).Value
  14. Next
  15. Next
  16. End With

  17. With Sheet5
  18. .Activate
  19. .Range("a1").Activate
  20. For i = 1 To myobject.Count
  21. For j = 1 To myobject(Application.Small(myobject.keys, i))
  22. ActiveCell.Value = Application.Small(myobject.keys, i)
  23. For k = 2 To myrow
  24. ActiveCell.Offset(k - 1, 0).Value = myobject2(Application.Small(myobject.keys, i) & "," & j & "," & k)
  25. Next
  26. ActiveCell.Offset(0, 1).Select
  27. Next
  28. Next
  29. End With

  30. Set myobject = Nothing
  31. Set myobject2 = Nothing

  32. End Sub
½Æ»s¥N½X
³o­Ó¬OÀu¤Æµ{¦¡,²Ä¤@¦æ­«ÂФ]¥i¨Ï¥Î
§Ú¨ì¦¹¬°¤î¤F.....
80 ¦r¸`¥H¤º
¤£¤ä«ù¦Û©w¸q Discuz! ¥N½X

TOP

        ÀR«ä¦Û¦b : §g¤l¬°¥Ø¼Ð¡A¤p¤H¬°¥Øªº¡C
ªð¦^¦Cªí ¤W¤@¥DÃD