以下是後學藉此題練習字典去除重複的心得與註解
Option Explicit
Sub 資料以字典去除重複轉為驗證清單()
Dim i&, Y, arr
'↑宣告變數:i是長整數,(Y,arr)是通用型變數
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y是 字典
For i = 1 To [A65536].End(xlUp).Row
'↑設順迴圈!i從1到A欄有內容儲存格最後列號
Y(Trim(Cells(i, "A"))) = ""
'↑令迴圈儲存格的值去除頭尾的空白字元後當key,item是空字元,放入字典中
Next
arr = Application.Transpose(Application.Transpose(Y.KEYS))
'↑令arr是一維陣列!用Y字典的key轉置兩次的值放入這陣列中
With [工作表1!B:B].Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(arr, ",")
'因為Formula1:=後面要給一個","符號可分割的字串,所以JOIN() 就可以了
'https://learn.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/join-function
End With
Set Y = Nothing
Erase arr
End Sub作者: dou10801 時間: 2022-12-21 09:03
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 時間: 2022-12-24 20:50
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 時間: 2023-3-2 08:19
也有調用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 時間: 2023-3-3 06:51
