1. 程式人生 > 其它 >1、一維陣列排序

1、一維陣列排序

一維陣列排序

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