VB实现6大排序算法：插入排序、基数排序、快速排序、希尔排序、选择排序、归并排序。可以随机生成指定个数的数据，显示排序过程，给出排序结果，计算排序算法消耗的时间。
生成随机数：
排序结果：
插入排序：
选择排序：
归并排序：
快速排序：
希尔排序：
基数排序：
核心代码
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 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 - 1
ReDim 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 Num
m = i
t = L(i)
For j = i + 1 To Num
If t > L(j) Then
t = L(j)
m = j
End If
Next j
If m <> j Then
t = L(i)
L(i) = L(m)
L(m) = t
End 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 > Left
Aux(i - 1) = A(i - 1)
i = i - 1
Wend
For j = m To Right - 1
Aux(Right + m - j) = A(j + 1)
Next j
For k = Left To Right
If Aux(j) < Aux(i) Then
A(k) = Aux(j)
j = j - 1
Else
A(k) = Aux(i)
i = i + 1
End 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 - 1
Wend
If (i < j) Then
L(i) = L(j)
i = i + 1
End If
While (i < j And L(i) < Pivotkey)
i = i + 1
Wend
If (i < j) Then
L(j) = L(i)
j = j - 1
End 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 Boolean
If Item < 0 Then Less = False: Exit Function
Less = 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 Right
j = i
V = A(i)
While (j >= L + h And Less(V, A, j - h))
A(j) = A(j - h)
j = j - h
Wend
A(j) = V
If En Then Disp
Next i
h = 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 n
If Max < A(i) Then Max = A(i)
Next i
ReDim Aux(Max + 1)
For i = 0 To n
m = A(i)
Aux(m) = Aux(m) + 1
Next i
m = 0
For i = 0 To Max
Count = Aux(i)
If Count <> 0 Then
For j = 0 To Count - 1
A(m) = i
m = m + 1
Next j
End 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 n
If (A(i) < A(i - 1)) Then
Tmp = A(i)
A(i) = A(i - 1)
j = i - 2
While (Less(Tmp, A, j))
j = j - 1
If (j >= 0) Then
A(j + 1) = A(j)
End If
Wend
A(j + 1) = Tmp
End If
Next i
End Sub
Private Sub Class_Terminate()
Erase Aux
End Sub
获取完整源代码，请私信博主。