|
笔者在学习VB中发现利用集合可以进行排序，优化后比冒泡法快得多。下面是完整的函数代码，演示了如何进行数组的升序或降序排列。 Option Explicit Dim X(100) As Double Dim y(100) As String Private Sub Command1_Click() '演示数字排序 Dim a(100) As Double, z(100) As String, i As Long For i = 0 To 100 a(i) = X(i) '复制数组 z(i) = CStr(X(i)) '转化为字符串数组 Next MsgBox Join(z, ","), 64, "原始数组" '显示原始顺序 NUMBERSORT X, "up" For i = 0 To 100 z(i) = CStr(X(i)) '转化为字符串数组 Next MsgBox Join(z, ","), 64, "按数字升序排序后数组" '显示排序结果 NUMBERSORT a, "down" For i = 0 To 100 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 Private Sub Command2_Click() '演示字符串排序 Dim z(100) As String, i As Long '复制数组 For i = 0 To 100 z(i) = y(i) Next MsgBox Join(y, ","), 64, "原始数组" '显示原始顺序 STRINGSORT y, "UP" MsgBox Join(y, ","), 64, "按字符串升序排序后数组" '显示排序结果 STRINGSORT z, "DOWN" MsgBox Join(z, ","), 64, "按字符串降序排序后数组" '显示排序结果 End Sub Private Sub Command3_Click() ' 排序计时 Dim a(3000) As String, i As Long, starttime As Long, endtime As Long For i = 0 To 3000 a(i) = Chr(Int(Rnd * 26) + 65) & Chr(Int(Rnd * 26) + 65) & Chr(Int(Rnd * 26) + 65) & Chr(Int(Rnd * 26) + 65) & Chr(Int(Rnd * 26) + 65) & Chr(Int(Rnd * 26) + 65) '生成随机6字符的字符串 Next starttime = Timer '计时开始 STRINGSORT a endtime = Timer '计时结束 MsgBox "排序共耗时 " & endtime - starttime & " 秒！" End Sub Private Sub Form_Load() Randomize Dim i As Long For i = 0 To 100 X(i) = Format(Rnd * 1000, "0.00") y(i) = Chr(Int(Rnd * 26) + 65) & Chr(Int(Rnd * 26) + 65) & Chr(Int(Rnd * 26) + 65) Next End Sub | 