1 2 3 4

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

  

posted @ 2021-12-08 13:55  I我的博客I  阅读(224)  评论(0编辑  收藏  举报