Option Explicit
Rem 20230509 YouChat大菩薩
Rem 在 VBA 中,可以使用 IsArray 函數來判斷一個變量是否是一個數組,但無法確定數組是否具有元素。 如果要檢查數組是否已初始化,可以使用 UBound 函數,該函數返回數組中可用的最後一個索引。 如果數組未初始化,則將返回 -1。 以下是使用 IsArray 和 UBound 函數的示例代碼:
Function IsArrayAlready(myArray) As Boolean
' Dim myArray() As Integer
' Check if array is initialized
If IsArray(myArray) And UBound(myArray) > -1 Then
' Array is initialized and has at least one element
IsArrayAlready = True
Else
' Array is not initialized or has no elements
End If
Rem 注意:無法直接檢查數組中是否存在元素,但是可以通過 UBound 函數檢查數組中可用的最後一個索引,以此來確定數組中是否有元素。
End Function
Rem 20230328 Adrenaline :
Rem 漢字會照部首再筆畫排序
Public Sub SortArray_QuickSort(arrayToSort As Variant) 'VBA引數預設為傳址(pass by reference)
' Dim arrayToSort As Variant
' Dim i As Integer
'
' ' 取得陣列
' arrayToSort = Application.Transpose(ExistedNumColumnRange.value)
'
' 用 QuickSort 排序
'Call QuickSortArray(arrayToSort, 1, UBound(arrayToSort))
Call QuickSortArray(arrayToSort, LBound(arrayToSort), UBound(arrayToSort))
' ' 輸出排序後的結果
' Debug.Print "排序後的結果:"
' For i = 1 To UBound(arrayToSort)
' Debug.Print arrayToSort(i)
' Next i
End Sub
Private Sub QuickSortArray(ByRef arr As Variant, ByVal left As Long, ByVal right As Long)
Dim i As Long
Dim j As Long
Dim pivot As Variant
Dim temp As Variant
i = left
j = right
pivot = arr((left + right) \ 2)
While i <= j
While arr(i) < pivot And i < right
i = i + 1
Wend
While pivot < arr(j) And j > left
j = j - 1
Wend
If i <= j Then
temp = arr(i)
arr(i) = arr(j)
arr(j) = temp
i = i + 1
j = j - 1
End If
Wend
If left < j Then
Call QuickSortArray(arr, left, j)
End If
If i < right Then
Call QuickSortArray(arr, i, right)
End If
End Sub
Rem creedit with chatGPT大菩薩
Rem 漢字會照筆畫再部首排序
Sub SortStringArray(ByRef arr() As String)
'arr = Array("apple", "banana", "cherry")
QuickSort arr, LBound(arr), UBound(arr) 'chatGPT大菩薩:LBound 是一個 VBA 函數,它會回傳陣列的下界(Lower Bound),也就是陣列的第一個元素的索引。在大多數情況下,陣列的下界是 0,但有時也可以定義成其他數字。例如,如果定義了一個索引為 1 到 10 的陣列,那麼 LBound 的值就是 1。
'For Each s In arr
'Debug.Print s
'Next s
End Sub
Private Sub QuickSort(ByRef arr() As String, ByVal l As Long, ByVal r As Long) 'l=left,r=right chatGPT大菩薩:是的,在這個 QuickSort 函數中, l 參數代表左邊的索引位置,而 r 參數代表右邊的索引位置。這些參數是快速排序算法的主要部分,用於指定排序的邊界。在這個函數中, arr 數組是要進行排序的數組, l 和 r 指定了要進行排序的數組的區間。
If l >= r Then Exit Sub
Dim i As Long, j As Long, X As String
i = l: j = r: X = arr((l + r) \ 2)
'Do
' While arr(i) < x
' i = i + 1
' Wend
' While x < arr(j)
' j = j - 1
' Wend
' If i <= j Then
' Swap arr(i), arr(j)
' i = i + 1
' j = j - 1
' End If
'Loop Until i > j
Do
While StrComp(arr(i), X, vbTextCompare) < 0
i = i + 1
Wend
While StrComp(X, arr(j), vbTextCompare) < 0
j = j - 1
Wend
If i <= j Then
Swap arr(i), arr(j)
i = i + 1
j = j - 1
End If
Loop Until i > j
QuickSort arr, l, j
QuickSort arr, i, r
End Sub
Private Sub Swap(ByRef a As String, ByRef b As String)
Dim temp As String
temp = a
a = b
b = temp
End Sub
Rem Bing大菩薩'https://www.notion.so/Characters-76ccb4ff823e4a82b0d0af042e5a650b?pvs=4#d7f45c8d4863487db4d92e4cb7787525
'如果只保留漢字中文排序,則 hanOnly=true
Function CharactersToArray(myRange As Range, Optional hanOnly As Boolean = False) As String()
Dim myArray() As String, arr, e, xRng As String
Dim i As Long
If hanOnly Then
arr = Str.Symbol_withoutEnter
xRng = myRange.Text
For Each e In arr
xRng = VBA.Replace(xRng, e, "")
Next e
myRange.Text = VBA.Replace(xRng, Chr(13), "")
End If
ReDim myArray(1 To myRange.Characters.Count)
For i = 1 To myRange.Characters.Count
myArray(i) = myRange.Characters(i)
Next i
CharactersToArray = myArray
End Function