放到office Excel VBE运行就行
[Visual Basic] 纯文本查看 复制代码Sub RecSortTest()
arr = WorksheetFunction.Transpose([a1].CurrentRegion) '如果工作表区域要转为一维数组
trr = RecSort(arr) '仅排序(按默认格式)
trr1 = RecSort(arr, 1) '去重复排序(按默认格式)
trr2 = RecSort(arr, 1, 1) '去重复排序 数值不按文本格式
Stop
End Sub
Function RecSort(arr, Optional z& = 0, Optional c& = 0) 'A-Z 升序排序(/可去重复)的自定义过程
Dim i&, j&, k&, l&, n&, u&, t
l = LBound(arr): n = l: u = UBound(arr)
ReDim trr(l To u)
For i = l To u
t = arr(i): If c Then If IsNumeric(t) Then t = Val(t) 'c=1 按数值/c=0 按源数据格式
For j = l To n
If z Then If trr(j) = t Then n = n - 1: Exit For 'z=1 去重复/z=0 保留
If trr(j) > t Then '检查直到比当前值t大位置时停止
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)
RecSort = trr
End Function
