1、一維陣列排序
阿新 • • 發佈:2021-12-08
一維陣列排序
Sub RecSortTest() '應用測試 arr = Array("a612", "c23", "456", "b374", 384, 2718, 8174, "7", 47, "47", 2874, "47", 374, 37, 47, "348") trr = RecSort(arr) '不去重複 按原值格式排序 trr1 = RecSort(arr, 1) '去重複 按原值格式排序 trr2 = RecSort(arr, 1, 1) '去重複 且按數值排序 trr3 = RecSort(arr, 1, -1) '去重複 且按文字數值排序 Stop End Sub Function RecSort(arr, Optional z& = 0, Optional c& = 0) '引數-1:arr 對一維陣列arr中的內容進行A-Z排序 '引數-2:z 可以指定z=1 去重複、z=0 不去重複 預設z=0不去重複 '引數-3:c 可以指定對數值內容的排序模式 ' 預設c=0 保持原資料格式(文字、數值分開排序,先數值後文本) 如: 1、3、12、"1"、"12"、"2"、"21"、"3" ' c=1 一律按數值排序如 1、2、3、21、33 ' c=-1 一律按文字排序如 "1"、"2"、"21"、"3"、"33" Dim i&, j&, k&, l&, n&, u&, t l = LBound(arr): n = l: u = UBound(arr) ReDim trr(l To u) '定義存放排序結果的陣列trr For i = l To u '遍歷檢查 t = arr(i): If IsNumeric(t) Then If c = 1 Then t = Val(t) Else If c = -1 Then t = CStr(t) '如為數值 則根據c引數轉換 c=1 轉為數值 =0 保持原來格式 =-1 轉為文字數值 For j = l To n '遍歷檢查已有資料 If z Then If trr(j) = t Then n = n - 1: Exit For 'z=1 去重複/=0 重複可 If trr(j) > t Then For k = n To j + 1 Step -1 '倒序交換位置空出新位置 trr(k) = trr(k - 1) Next trr(k) = t '空出位置插入新值t Exit For End If Next If j > n Then trr(j - 1) = t '最後位置插入新值t n = n + 1 Next If z Then ReDim Preserve trr(l To n - 1) '去重複時重新定義陣列trr大小 RecSort = trr '輸出排序後的一維陣列結果 End Function