singo1232001

回復 10# dou10801


    Sub SortArray()
  arr = Array("a", "b", "c", "d", "e", "C", "b")
  'arr = Y.keys()
  QuickSort arr, LBound(arr), UBound(arr)
  Debug.Print Join(arr, ",")
End Sub

Function QuickSort(ByRef ar, ByVal iLo As Long, ByVal iHi As Long)
  Dim pivot As Variant, lo, hi As Long
  
  lo = iLo: hi = iHi
  pivot = UCase(ar((lo + hi) \ 2))
  
  While lo <= hi
    While (UCase(ar(lo)) < pivot And UCase(lo) < UCase(iHi)): lo = lo + 1: Wend
    While (UCase(ar(hi)) > pivot And UCase(hi) > UCase(iLo)): hi = hi - 1: Wend
    If (lo <= hi) Then
      tmp = ar(lo): ar(lo) = ar(hi): ar(hi) = tmp
      lo = lo + 1: hi = hi - 1: tmp = ""
    End If
  Wend
  
  If hi > iLo Then QuickSort ar, iLo, hi
  If lo < iHi Then QuickSort ar, lo, iHi
End Function

dou10801

回復 11# singo1232001 感謝指導,收下,慢慢消化.

Andy2483

回復 11# singo1232001


    謝謝前輩指導
後學藉此帖習得陣列排序相關知識,請前輩再指導

執行結果:

下載 (7.74 KB)

2022-12-26 13:42

程式碼心得註解如下:

Option Explicit
Sub SortArray()
Dim Arr, Y, i
'↑宣告變數:Arr,Y,i是通用變數
Arr = Array("4A", "5A", "6A", "7A", "2A", "4A", "6A", "1A", "2A", "3A")
'↑令Arr是一維陣列
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y是 字典
For Each i In Arr
'↑設順迴圈!令i是 Arr陣列裡的一員,從前面輪到後面
   Y(i) = ""
   '↑令以i變數值為key,item是空字元,放入Y字典中
Next
Arr = Y.KEYS()
'↑令Arr倒調原來陣列值,換裝Y字典key組成的陣列值
QuickSort Arr, LBound(Arr), UBound(Arr)
'↑給QuickSort這自訂函數3個 變數令其回傳值
'1.ar變數: Arr陣列
'2.iLo&: LBound(Arr):Arr陣列最小索引號數
'3.iHi&: UBound(Arr):Arr陣列最大索引號數
Debug.Print Join(Arr, ",")
'↑在即時運算窗顯示: 以","符號連結 Arr陣列值的字串結果
End Sub


Function QuickSort(ByRef ar, ByVal iLo As Long, ByVal iHi As Long)
'宣告ar是通用型變數,ByRef_指定傳遞引數的方式是呼叫程式可以變更呼叫程式內引數基礎的變數值。
'宣告iLo, iHi 是長整數,ByVal指定引數是以 傳值方式傳遞
Dim pivot As Variant, tmp As Variant, lo As Long, hi As Long
'↑宣告變數:(pivot,tmp)是通用型變數,(lo,hi)是長整數
lo = iLo
'↑令lo這通用型變數是iLo變數代的值 (Arr陣列最小索引號數)
hi = iHi
'↑令hi這通用型變數是iHi變數代的值 (Arr陣列最大索引號數)
pivot = UCase(ar((lo + hi) \ 2))
'↑令pivot是 ((Arr陣列最小索引號數+最大索引號數)/2 去尾整數值)索引號的ar陣列值再轉為大寫英文字
While lo <= hi
'↑設當lo變數<= hi變數 條件成立執行的迴圈
   While (UCase(ar(lo)) < pivot And lo < iHi)
   '↑設當lo變數陣列值再轉大寫 < pivot變數,而且lo變數 < iHi變數,條件成立執行的迴圈
      lo = lo + 1
      '↑令lo變數累加 1
   Wend
   While (UCase(ar(hi)) > pivot And hi > iLo)
   '↑設當hi變數陣列值再轉大寫 > pivot變數,而且hi變數 > iLo變數,條件成立執行的迴圈
      hi = hi - 1
      '↑令hi變數逐次減 1
   Wend
   If lo <= hi Then
   '↑如果 lo變數 <= hi變數
      tmp = ar(lo)
      '↑令tmp這通用型變數是 lo變數索引號的ar陣列值
      ar(lo) = ar(hi)
      '↑令lo變數索引號的ar陣列值是 hi變數索引號的ar陣列值
      ar(hi) = tmp
      '↑令hi變數索引號的ar陣列值是 tmp這通用型變數值
      lo = lo + 1
      '↑令lo變數累加 1
      hi = hi - 1
      '↑令hi變數逐次減 1
      tmp = ""
      '↑令tmp這通用型變數是 空字元
   End If
Wend
If hi > iLo Then QuickSort ar, iLo, hi
'↑如果hi變數 > iLo變數,給QuickSort這自訂函數3個 變數令其回傳值
'1.ar變數: ar陣列
'2.iLo&: iLo變數
'3.iHi&: hi變數
If lo < iHi Then QuickSort ar, lo, iHi
'↑如果lo變數 < iHi變數,給QuickSort這自訂函數3個 變數令其回傳值
'1.ar變數: ar陣列
'2.iLo&: lo變數
'3.iHi&: iHi變數
End Function

Scott090

回復 13# Andy2483

太精采了也學習了
謝謝

singo1232001

回復 14# Scott090

也有調用SQL的寫法   此種寫法要創一張名為"sortSQL"的工作表,表可隱藏  檔案要有檔名
Sub SortArray()
arr = Array("a", "b", "c", "d", "e", "C", "b")
orderSQL arr
Debug.Print Join(arr, ",")
End Sub

Function orderSQL(ar)
With CreateObject("adodb.connection"): V = Application.Version
If V >= 12 Then V = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0; "
If V < 12 Then V = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0; "
.Open V & "Data Source=" & ThisWorkbook.FullName
Set s = Sheets("sortSQL"): s.[A:A].ClearContents: s.[a1] = "sort"
s.[a2].Resize(UBound(ar) + 1, 1) = Application.Transpose(ar)
q = "select * from [sortSQL$A:A] order by sort"
ar = Application.Index(.Execute(q).getrows, 1, 0): End With
End Function

Scott090

回復 15# singo1232001

感恩 再次深入地說明