Option Explicit
Private Sub Command1_Click() '演示数字排序Dim a(10) As Double, z(10) As String, i As LongDim X(10) As DoubleX(0) = 10X(1) = 2X(2) = 3X(3) = 1X(4) = 0X(5) = 3X(6) = 4X(7) = 4X(8) = 56For i = 0 To 10a(i) = X(i) '复制数组z(i) = CStr(X(i)) '转化为字符串数组NextMsgBox Join(z, ","), 64, "原始数组" '显示原始顺序
NUMBERSORT X, "up"For i = 0 To 10z(i) = CStr(X(i)) '转化为字符串数组NextMsgBox Join(z, ","), 64, "按数字升序排序后数组" '显示排序结果
NUMBERSORT a, "down"For i = 0 To 10z(i) = CStr(a(i)) '转化为字符串数组NextMsgBox Join(z, ","), 64, "按数字降序排序后数组" '显示排序结果
End SubSub NUMBERSORT(ByRef a() As Double, Optional sort As String = "up") '数字排序Dim min As Long, max As Long, num As Long, first As Long, last As Long, temp As Long, all As New Collection, steps As Longmin = LBound(a)max = UBound(a)all.Add a(min)steps = 1For num = min + 1 To maxlast = all.CountIf a(num) < CDbl(all(1)) Then all.Add a(num), BEFORE:=1: GoTo nextnum '加到第一项If a(num) > CDbl(all(last)) Then all.Add a(num), AFTER:=last: GoTo nextnum '加到最后一项
first = 1Do While last > first + 1 '利用DO循环减少循环次数temp = (last + first) / 2If a(num) > CDbl(all(temp)) Thenfirst = tempElselast = tempsteps = steps + 1End IfLoopall.Add a(num), BEFORE:=last '加到指定的索引
nextnum:steps = steps + 1NextFor num = min To maxIf sort = "UP" Or sort = "up" Then a(num) = CDbl(all(num - min + 1)): steps = steps + 1 '升序If sort = "DOWN" Or sort = "down" Then a(num) = CDbl(all(max - num + 1)): steps = steps + 1 '降序NextMsgBox "本数组共经过 " & steps & "步实现" & IIf(sort = "UP" Or sort = "up", "升序", "降序") & "排序！", 64, "INFORMATION"Set all = NothingEnd Sub
Sub STRINGSORT(ByRef a() As String, Optional sort As String = "UP") '字符串排序Dim min As Long, max As Long, num As Long, first As Long, last As Long, temp As Long, all As New Collection, steps As Longmin = LBound(a)max = UBound(a)all.Add a(min)steps = 1For num = min + 1 To max
first = 1last = all.CountIf a(num) < all(1) Then all.Add a(num), BEFORE:=1: GoTo nextnum '加到第一项If a(num) > all(last) Then all.Add a(num), AFTER:=last: GoTo nextnum '加到最后一项
Do While last > first + 1 '利用DO循环减少循环次数temp = (last + first) / 2If a(num) > all(temp) Thenfirst = tempElselast = tempsteps = steps + 1End IfLoopall.Add a(num), BEFORE:=last '加到指定的索引
nextnum:steps = steps + 1NextFor num = min To maxIf sort = "UP" Or sort = "up" Then a(num) = all(num - min + 1): steps = steps + 1 '升序If sort = "DOWN" Or sort = "down" Then a(num) = all(max - num + 1): steps = steps + 1 '降序NextMsgBox "本数组共经过 " & steps & "步实现" & IIf(sort = "UP" Or sort = "up", "升序", "降序") & "排序！", 64, "INFORMATION"Set all = NothingEnd Sub
