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

asus103

¦U¦ì¤j¤j±z­Ì¦n
¦pªG·Q±N¨â°}¦C¨Ì¥Ñ¤p¦Ó¤j¶¶§Ç¦X¨Ö°ÝÃD
¦p¡G
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
±NA¡AB¨â°}¦C¦X¨Ö¦¨C°}¦C¡A¨Ã±N¨ä¾l¬Û¹ïÀ³¸ê®Æ§Û¿ý¡A
À³¸Ó¦p¦ó¸Ñ¨M

·PÁ¦U¦ìªº¨ó§U

Andy2483

¦^´_ 21# Hsieh


    ÁÂÁ«e½ú,ÁÂÁ½׾Â
«á¾ÇÂǦ¹©«½m²ß°}¦C¦b¦r¨å¸Ì§]¦R¤§¶¡½s¿è°}¦C­È»P Àx¦s®æ¦P¦r¤¸¼Æ¾î¦V±Æ§Ç,½m²ß¤è®×¦p¤U
½Ð«e½ú­Ì«ü±Ð

¸ê®Æªí(¤u§@ªí1):

¤U¸ü (55.62 KB)

2023-3-28 13:00

¸ê®Æªí(¤u§@ªí2):

¤U¸ü (53.9 KB)

2023-3-28 13:01

µ²ªGªí(¤u§@ªí3):

¤U¸ü (80.29 KB)

2023-3-28 13:01

Option Explicit
Sub TEST_2()
Application.ScreenUpdating = False
Dim Y, N&, i&, j&, A, C%
Set Y = CreateObject("Scripting.Dictionary")
Sheets(3).UsedRange.Clear
For i = 1 To 2
   Y("ªí" & i) = Sheets(i).Range("A1").CurrentRegion: A = Y("ªí" & i)
   Y(i & "/R") = UBound(A): Y(i & "/C") = UBound(A, 2)
   For j = 1 To Y(i & "/C")
      N = N + 1: A(1, j) = Format(A(1, j), "000") & "|" & Format(N, "000")
   Next
   Y("ªí" & i) = A
Next
Sheets(3).[A1].Resize(Y("1/R"), Y("1/C")) = Y("ªí1")
Sheets(3).[A1].Item(1, Y("1/C") + 1).Resize(Y("2/R"), Y("2/C")) = Y("ªí2")
With Sheets(3).UsedRange
   .Sort Key1:=.Item(1), Order1:=xlAscending, Header:=xlNo, _
   Orientation:=xlLeftToRight
   Intersect([1:1], .Cells).Replace "|*", "", Lookat:=xlPart
End With
Set Y = Nothing
End Sub

asus103

·PÁÂHsieh¡BFAlonso¨â¦ì¤j¤j
§Ú±q³o­Ó°Q½×ªº¹Lµ{¤¤¦¬Ã¬«Ü¦h
·|¦Aªá®É¶¡¦n¦n§l¦¬¨ä¤¤ºëµØ
¦Ó¥Bµ{¦¡½X­È±o¨åÂáA¥H«á¥²µM©|¦³¾÷·|¥Î¨ì

·PÁ¦A¤T

Hsieh

¦^´_ 16# asus103

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

½Æ»s¥N½X

Array_Sort.zip (11.64 KB)

¤U¸ü¦¸¼Æ: 8

2011-1-15 21:40

FAlonso

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. 
   
7. Set myobject = CreateObject("scripting.dictionary")
   
8. Set myobject2 = CreateObject("scripting.dictionary")
   
9. 
   
10. myrow = Sheet4.Range("A65536").End(xlUp).Row
    
11. 
    
12. With Sheet4
    
13. For Each myrange In .Range(.[a1], .[a1].End(xlToRight))
    
14. myobject(myrange.Value) = myobject(myrange.Value) + 1
    
15. For j = 2 To myrow
    
16. myobject2(myrange.Value & "," & myobject(myrange.Value) & "," & j) = myrange.Offset(j - 1).Value
    
17. Next
    
18. Next
    
19. End With
    
20. 
    
21. With Sheet5
    
22. .Activate
    
23. .Range("a1").Activate
    
24. For i = 1 To myobject.Count
    
25. For j = 1 To myobject(Application.Small(myobject.keys, i))
    
26. ActiveCell.Value = Application.Small(myobject.keys, i)
    
27. For k = 2 To myrow
    
28. ActiveCell.Offset(k - 1, 0).Value = myobject2(Application.Small(myobject.keys, i) & "," & j & "," & k)
    
29. Next
    
30. ActiveCell.Offset(0, 1).Select
    
31. Next
    
32. Next
    
33. End With
    
34. 
    
35. Set myobject = Nothing
    
36. Set myobject2 = Nothing
    
37. 
    
38. End Sub

½Æ»s¥N½X

³o­Ó¬OÀu¤Æµ{¦¡,²Ä¤@¦æ­«ÂФ]¥i¨Ï¥Î
§Ú¨ì¦¹¬°¤î¤F.....

FAlonso

¬Ý²Ä20­¶,¨º­Ó¬O³Ì²×µ{¦¡

Hsieh

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

FAlonso

¦^´_ 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. 
   
6. Set myobject = CreateObject("scripting.dictionary")
   
7. Set myobject2 = CreateObject("scripting.dictionary")
   
8. 
   
9. With Sheet4
   
10. For Each myrange In .Range(.[a1], .[a1].End(xlToRight))
    
11. myobject(myrange.Value) = myobject(myrange.Value) + 1      'myrange.value¬°²Ä1 row¬Y¼Æ¦r,myobject§@¬°­p¼Æ¾¹
    
12. myobject2(myrange.Value & "," & myobject(myrange.Value)) = myrange.Offset(1).Value  myobject2¿é¤J²Ä2 rowªº¼Æ¦r(index¬°myrange.Value & "," & myobject(myrange.Value,§Y¼Æ¦r¤Î¨ä¥X²{¦¸¼Æ)
    
13. Next
    
14. End With
    
15. 
    
16. With Sheet5
    
17. .Activate
    
18. .Range("a1").Activate
    
19. For i = 1 To myobject.Count   '¥ý¼Æ¦³¦h¤Öµ§¤£¦Pªº¸ê®Æ
    
20. For j = 1 To myobject(Application.Small(myobject.keys, i))       '¥ý±Æ¦C,¦A§ä¥X¨ä¥X²{¦¸¼Æ
    
21. ActiveCell.Value = Application.Small(myobject.keys, i)            
    
22. ActiveCell.Offset(1, 0).Value = myobject2(Application.Small(myobject.keys, i) & "," & j)
    
23. ActiveCell.Offset(0, 1).Select
    
24. Next
    
25. Next
    
26. End With
    
27. 
    
28. Set myobject = Nothing
    
29. Set myobject2 = Nothing
    
30. 
    
31. End Sub

½Æ»s¥N½X

asus103

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

FAlonso

¦^´_ 14# Hsieh
¤U¸ü¤£¨ì