Hsieh

¦^´_ 1# asus103
¦³¨Ç¼Æ­È¸ò§AA¡BB°}¦C¨ú±o¤è¦¡¦³Ãö
¥HÀx¦s®æ½d³ò¬°°}¦C¬°¨Ò

1. Sub nn()
   
2. Dim Ar(), Ay(), C(), A, B
   
3. A = [B1:D2]: B = [F1:I2]
   
4. For i = LBound(A, 1) To UBound(A, 1)
   
5.    For j = LBound(A, 2) To UBound(A, 2)
   
6.    ReDim Preserve Ar(s)
   
7.    Ar(s) = A(i, j) '¨ú±oA°}¦C
   
8.    s = s + 1
   
9.    Next
   
10.    For j = LBound(B, 2) To UBound(B, 2)
    
11.    ReDim Preserve Ar(s)
    
12.    Ar(s) = B(i, j) '¨ú±oB°}¦C
    
13.    s = s + 1
    
14.    Next
    
15.    ReDim Ay(s)
    
16.    For j = 0 To UBound(Ar)
    
17.      Ay(j) = Application.Small(Ar, j + 1) '±Æ§Ç
    
18.    Next
    
19.    ReDim Preserve C(k)
    
20.    C(k) = Ay: s = 0: Erase Ay '¥[¤J¸ê®Æ¨ìC°}¦C¡A§â¼È¦s°}¦C²M°£
    
21.    k = k + 1
    
22. Next
    
23. [K1].Resize(k, UBound(A, 2) + UBound(B, 2)) = Application.Transpose(Application.Transpose(C))
    
24. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 3# asus103

¤£À´§A©Ò¿×
¨Ã±N¨ä¾l¬Û¹ïÀ³¸ê®Æ§Û¿ý
½Ð¤W¶Ç§Aªº½d¨Ò»¡©ú

Hsieh

¦^´_ 5# asus103

1. Sub ex()
   
2. Dim C()
   
3. Open "test.txt" For Output As #1 '²£¥Í¼È¦sÀÉ
   
4. A = [B1:D2]: B = [F1:I2]
   
5. For i = LBound(A, 2) To UBound(A, 2)
   
6. Print #1, A(1, i) & "," & A(2, i)
   
7. Next
   
8. For i = LBound(B, 2) To UBound(B, 2)
   
9. Print #1, B(1, i) & "," & B(2, i)
   
10. Next
    
11. Close #1
    
12. Shell "sort / " & "test.txt" & " /o " & "temp.txt" '²£¥Í±Æ§Ç¼È¦sÀÉ
    
13. '°»´úª½¨ìÀɮײ£¥Í,¦AÄ~Äò«á­±ªº°Ê§@
    
14. While Dir("temp.txt") = ""
    
15. Wend
    
16. Open "temp.txt" For Input As #1
    
17. Do Until EOF(1)
    
18. Line Input #1, mystr
    
19. ReDim Preserve C(s)
    
20. C(s) = Split(mystr, ",")
    
21. s = s + 1
    
22. Loop
    
23. Close #1
    
24. Kill "test.txt" '§R°£¼È¦sÀÉ
    
25. Kill "temp.txt" '§R°£±Æ§Ç¼È¦sÀÉ
    
26. [B12].Resize(2, s) = Application.Transpose(C)
    
27. End Sub

½Æ»s¥N½X

sort«ü¥O¬OWindows­ì¥»´N¦³ªºDOS«ü¥O¡A¥Î©ó±Æ§Ç¯Â¤å¦rÀÉ¡C
¥H¤Wµ{¦¡³q¹LWindows7+Excel2010´ú¸Õ¡F
­Y¦b§Aªº¹q¸£°õ¦æ¦³»~¡A½Ð½T»{§Aªº¹q¸£¸Ì¦³ sort.exe ³o­Ó°õ¦æÀÉ¡C

Hsieh

¦^´_ 7# asus103

1. Sub yy() '®ðªw±Æ§Ç
   
2. Dim Ar(), Ay()
   
3. A = [B1:D2]: B = [F1:I2]
   
4. For Each y In Array(A, B)
   
5. For i = LBound(y, 2) To UBound(y, 2)
   
6. ReDim Preserve Ar(s)
   
7. ReDim Preserve Ay(s)
   
8.   Ar(s) = y(1, i)
   
9.   Ay(s) = y(2, i)
   
10.   s = s + 1
    
11. Next
    
12. Next
    
13. For i = 0 To UBound(Ar)
    
14.     For j = 0 To UBound(Ar) - 1
    
15.        If Ar(j + 1) < Ar(j) Then '»¼¼W
    
16.      'If Ar(j + 1) > Ar(j) Then  '»¼´î
    
17.       temp = Ar(j)
    
18.       temp1 = Ay(j)
    
19.       Ar(j) = Ar(j + 1)
    
20.       Ar(j + 1) = temp
    
21.       Ay(j) = Ay(j + 1)
    
22.       Ay(j + 1) = temp1
    
23.       
    
24.     End If
    
25.     Next
    
26. Next
    
27. [B15].Resize(, s) = Ar
    
28. [B16].Resize(, s) = Ay
    
29. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 9# asus103
¤@¯ë¼Ò²Õ

1. Declare Sub Sleep Lib "kernel32" (ByVal dwmilliseconds As Long) '«Å§iAPIªºSLEEP¨ç¼Æ
   
2. Sub nn()
   
3. t = Timer '¶}©l­p®É
   
4. For i = 1 To 10
   
5.   Sleep 500  '©µ¿ð500/1000¬í
   
6. Next
   
7. MsgBox "©µ¿ð" & Timer - t & "¬í"  "¨C¦¸©µ¿ð0.5¬í¡A¤Q¦¸©µ¿ð«á¦@©µ¿ð?¬í
   
8. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 13# FAlonso
­Y¦Ò¼{¯Á¤Þ­È·|­«½Æªº±¡§Î(²Ä¤@¦C¬Û¦P¡A¦ý²Ä¤G¦C¹ïÀ³­È¤£¦P)
¦p¹Ïªº¸ê®Æ

¤U¸ü (5.03 KB)

2011-1-14 20:35

±z·|¦p¦ó¸Ñ¨M?
Array_Sort.zip (10.21 KB)

¤U¸ü¦¸¼Æ: 5

2011-1-14 20:20

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

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

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