求vb 快速排序算法、插入排序源代码!!!!追加分!!!

随便举个例子演示一下,若有解释更好!

Option Explicit

Private Sub Form_Load()
Dim i As Integer, intC As Integer
Dim IntOuSus() As String, strOuSus As String
Dim IntJiSus() As String, strJiSus As String

Randomize
For i = 1 To 30
intC = CInt(Rnd * 90) + 10
If intC Mod 2 = 1 Then
strJiSus = strJiSus & IIf(strJiSus = "", "", ",") & intC
Else
strOuSus = strOuSus & IIf(strOuSus = "", "", ",") & intC
End If
Next
IntOuSus = Split(strOuSus, ",")
IntJiSus = Split(strJiSus, ",")

OrderNumbers IntJiSus, "ASC"
OrderNumbers IntOuSus, "DESC"

End Sub

'注意以下过程中第一个参数使用了ByRef
'此方法比传统的冒泡法快得多
Private Sub OrderNumbers(ByRef a() As String, Optional ByVal ASCDESC As String = "ASC")
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
ASCDESC = UCase(ASCDESC)
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 ASCDESC = "ASC" Then a(num) = CDbl(all(num - min + 1)): steps = steps + 1 '升序
If ASCDESC = "DESC" Then a(num) = CDbl(all(max - num + 1)): steps = steps + 1 '降序
Next
'MsgBox "本数组共经过 " & steps & "步实现" & IIf(ASCDESC = "ASC", "升序", "降序") & "排序!", 64, "INFORMATION"
Set all = Nothing
End Sub
温馨提示:答案为网友推荐,仅供参考
第1个回答  2009-11-16
'快速排序算法,对字符串数组进行排序
Private Sub quicksort(ByRef arrValue() As String, ByVal intLx As Integer, ByVal intRx As Integer)
'arrValue()是待排的数组,intLx,intRx为左右边界
Dim strValue As String
Dim I As Integer
Dim j As Integer
Dim intLoop As Integer
I = intLx
j = intRx
Do
While arrValue(I) <= arrValue(j) And I < j: I = I + 1: Wend
If I < j Then
strValue = arrValue(I)
arrValue(I) = arrValue(j)
arrValue(j) = strValue
End If
While arrValue(I) <= arrValue(j) And I < j: j = j - 1: Wend
If I < j Then
strValue = arrValue(I)
arrValue(I) = arrValue(j)
arrValue(j) = strValue

End If
Loop Until I = j
I = I - 1: j = j + 1

If I > intLx Then
Call quicksort(arrValue, intLx, I)
End If
If j < intRx Then
Call quicksort(arrValue, j, intRx)
End If
End Sub
Private Sub Form_Load()
Dim arr(8) As String
arr(0) = "r"
arr(1) = "e"
arr(2) = "a"
arr(3) = "n"
arr(4) = "b"
arr(5) = "u"
arr(6) = "c"
arr(7) = "o"
arr(8) = "f"
Call quicksort(arr, 0, UBound(arr))
End Sub
相似回答