传说中比冒泡排序快很多的排序方法（vb）

Option Explicit

Private Sub Command1_Click() '演示数字排序
Dim a(10) As Double, z(10) As String, i As Long
Dim X(10) As Double
X(0) = 10
X(1) = 2
X(2) = 3
X(3) = 1
X(4) = 0
X(5) = 3
X(6) = 4
X(7) = 4
X(8) = 56
For i = 0 To 10
a(i) = X(i) '复制数组
z(i) = CStr(X(i)) '转化为字符串数组
Next
MsgBox Join(z, ","), 64, "原始数组" '显示原始顺序

NUMBERSORT X, "up"
For i = 0 To 10
z(i) = CStr(X(i)) '转化为字符串数组
Next
MsgBox Join(z, ","), 64, "按数字升序排序后数组" '显示排序结果

NUMBERSORT a, "down"
For i = 0 To 10
z(i) = CStr(a(i)) '转化为字符串数组
Next
MsgBox Join(z, ","), 64, "按数字降序排序后数组" '显示排序结果

End Sub
Sub 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 Long
min = LBound(a)
max = UBound(a)
all.Add a(min)
steps = 1
For num = min + 1 To max
last = all.Count
If 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 = 1
Do While last > first + 1 '利用DO循环减少循环次数
temp = (last + first) / 2
If a(num) > CDbl(all(temp)) Then
first = temp
Else
last = temp
steps = steps + 1
End If
Loop
all.Add a(num), BEFORE:=last '加到指定的索引

nextnum:
steps = steps + 1
Next
For num = min To max
If 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 '降序
Next
MsgBox "本数组共经过 " & steps & "步实现" & IIf(sort = "UP" Or sort = "up", "升序", "降序") & "排序！", 64, "INFORMATION"
Set all = Nothing
End 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 Long
min = LBound(a)
max = UBound(a)
all.Add a(min)
steps = 1
For num = min + 1 To max

first = 1
last = all.Count
If 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) / 2
If a(num) > all(temp) Then
first = temp
Else
last = temp
steps = steps + 1
End If
Loop
all.Add a(num), BEFORE:=last '加到指定的索引

nextnum:
steps = steps + 1
Next
For num = min To max
If 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 '降序
Next
MsgBox "本数组共经过 " & steps & "步实现" & IIf(sort = "UP" Or sort = "up", "升序", "降序") & "排序！", 64, "INFORMATION"
Set all = Nothing
End Sub