VB實現6大排序算法：插入排序、基數排序、快速排序、希爾排序、選擇排序、歸并排序。可以隨機生成指定個數的數據，顯示排序過程，給出排序結果，計算排序算法消耗的時間。

生成隨機數：

排序結果：

插入排序：

選擇排序：

歸并排序：

快速排序：

希爾排序：

基數排序：

核心代碼

VERSION 1.0 CLASS
BEGINMultiUse = -1  'TruePersistable = 0  'NotPersistableDataBindingBehavior = 0  'vbNoneDataSourceBehavior  = 0  'vbNoneMTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Sort"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private Num As Long
Private Aux() As Integer
Private R() As Integer
Private Sub Class_Initialize()
Num = 0
End Sub
Public Property Let SetNum(ByVal NumberOfData As Long)Num = NumberOfData - 1ReDim Aux(NumberOfData)
End Property
Public Property Let SetRArray(ByRef RArray() As Integer)R = RArray
End Property
Public Sub selectSort(L() As Integer)
Dim i As Long
Dim j As Long
Dim m As Long
Dim t As Integer
For i = 0 To Numm = it = L(i)For j = i + 1 To NumIf t > L(j) Thent = L(j)m = jEnd IfNext jIf m <> j Thent = L(i)L(i) = L(m)L(m) = tEnd If
Next i
End Sub
Sub Merge(ByRef A() As Integer, ByVal Left As Long, ByVal m As Long, ByVal Right As Long)
Dim i As Long
Dim j As Long
Dim k As Long
i = m + 1
While i > LeftAux(i - 1) = A(i - 1)i = i - 1
Wend
For j = m To Right - 1Aux(Right + m - j) = A(j + 1)
Next j
For k = Left To RightIf Aux(j) < Aux(i) ThenA(k) = Aux(j)j = j - 1ElseA(k) = Aux(i)i = i + 1End If
Next k
End Sub
Public Sub mergeSort(ByRef L() As Integer, ByVal Left As Long, ByVal Right As Long)
Dim m As Long
m = Int(Left / 2 + Right / 2)
If Right <= Left Then Exit Sub
mergeSort L, Left, m
mergeSort L, m + 1, Right
Merge L, Left, m, Right
End Sub
Public Sub QuickSort(L() As Integer, ByVal Low As Long, ByVal High As Long)
Dim i As Long
Dim j As Long
Dim Pivotkey As Integer
i = Low: j = High
Pivotkey = L(Low)
While (i < j)While (i < j And Pivotkey <= L(j))j = j - 1WendIf (i < j) ThenL(i) = L(j)i = i + 1End IfWhile (i < j And L(i) < Pivotkey)i = i + 1WendIf (i < j) ThenL(j) = L(i)j = j - 1End If
Wend
L(i) = Pivotkey
If (Low < i) Then QuickSort L, Low, i - 1
If (i < High) Then QuickSort L, j + 1, High
End Sub
Private Function Less(ByVal V As Long, Rx() As Integer, ByVal Item As Long) As BooleanIf Item < 0 Then Less = False: Exit FunctionLess = V < Rx(Item)
End Function
Public Sub ShellSort(A() As Integer, ByVal Left As Long, ByVal Right As Long)
Dim i As Long
Dim j As Long
Dim h As Long
Dim V As Integer
Dim pa As Integer
h = 1
For i = 1 To (Right - Left) / (Num - 1)h = 3 * h + 1
Next i
While (h > 0 And DoEvents)For i = Left + h To Rightj = iV = A(i)While (j >= L + h And Less(V, A, j - h))A(j) = A(j - h)j = j - hWendA(j) = VIf En Then DispNext ih = Int(h / 3)
Wend
End Sub
Sub RadixSort(A() As Integer, ByVal n As Long)
Dim Max As Integer
Dim Count As Long
Dim m As Long
Max = 0
For i = 0 To nIf Max < A(i) Then Max = A(i)
Next iReDim Aux(Max + 1)
For i = 0 To nm = A(i)Aux(m) = Aux(m) + 1
Next im = 0
For i = 0 To MaxCount = Aux(i)If Count <> 0 ThenFor j = 0 To Count - 1A(m) = im = m + 1Next jEnd If
Next i
End Sub
Public Sub InsertSort(ByRef A() As Integer, ByVal n As Long)
Dim i As Long
Dim j As Long
Dim Tmp As Integer
For i = 1 To nIf (A(i) < A(i - 1)) ThenTmp = A(i)A(i) = A(i - 1)j = i - 2While (Less(Tmp, A, j))j = j - 1If (j >= 0) ThenA(j + 1) = A(j)End IfWendA(j + 1) = TmpEnd If
Next i
End SubPrivate Sub Class_Terminate()
Erase Aux
End Sub

獲取完整源代碼，請私信博主。