一维数组排序
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