VB实现6大排序算法---动态过程展示（建议收藏）

短命女 2022-10-09 13:28 79阅读 0赞

> VB实现6大排序算法：插入排序、基数排序、快速排序、希尔排序、选择排序、归并排序。可以随机生成指定个数的数据，显示排序过程，给出排序结果，计算排序算法消耗的时间。

**生成随机数：**

![在这里插入图片描述][watermark_type_ZmFuZ3poZW5naGVpdGk_shadow_10_text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L2x1Y2t5NTEyMjI_size_16_color_FFFFFF_t_70_pic_center]

**排序结果：**

![在这里插入图片描述][watermark_type_ZmFuZ3poZW5naGVpdGk_shadow_10_text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L2x1Y2t5NTEyMjI_size_16_color_FFFFFF_t_70_pic_center 1]  
**插入排序：**

![在这里插入图片描述][watermark_type_ZmFuZ3poZW5naGVpdGk_shadow_10_text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L2x1Y2t5NTEyMjI_size_16_color_FFFFFF_t_70_pic_center 2]

**选择排序：**

![在这里插入图片描述][watermark_type_ZmFuZ3poZW5naGVpdGk_shadow_10_text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L2x1Y2t5NTEyMjI_size_16_color_FFFFFF_t_70_pic_center 3]

**归并排序：**

![在这里插入图片描述][watermark_type_ZmFuZ3poZW5naGVpdGk_shadow_10_text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L2x1Y2t5NTEyMjI_size_16_color_FFFFFF_t_70_pic_center 4]  
**快速排序：**

![在这里插入图片描述][watermark_type_ZmFuZ3poZW5naGVpdGk_shadow_10_text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L2x1Y2t5NTEyMjI_size_16_color_FFFFFF_t_70_pic_center 5]  
**希尔排序：**

![在这里插入图片描述][watermark_type_ZmFuZ3poZW5naGVpdGk_shadow_10_text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L2x1Y2t5NTEyMjI_size_16_color_FFFFFF_t_70_pic_center 6]  
**基数排序：**

![在这里插入图片描述][watermark_type_ZmFuZ3poZW5naGVpdGk_shadow_10_text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L2x1Y2t5NTEyMjI_size_16_color_FFFFFF_t_70_pic_center 7]  
**核心代码**

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

> 获取完整源代码，请私信博主。

[watermark_type_ZmFuZ3poZW5naGVpdGk_shadow_10_text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L2x1Y2t5NTEyMjI_size_16_color_FFFFFF_t_70_pic_center]: /images/20221005/f02f65ab94004a54b31878b8a414b83b.png
[watermark_type_ZmFuZ3poZW5naGVpdGk_shadow_10_text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L2x1Y2t5NTEyMjI_size_16_color_FFFFFF_t_70_pic_center 1]: /images/20221005/731201434f3b4a84bd41b8e4e82b556a.png
[watermark_type_ZmFuZ3poZW5naGVpdGk_shadow_10_text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L2x1Y2t5NTEyMjI_size_16_color_FFFFFF_t_70_pic_center 2]: /images/20221005/56792eeb59ed4f7387749c94e3b09198.png
[watermark_type_ZmFuZ3poZW5naGVpdGk_shadow_10_text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L2x1Y2t5NTEyMjI_size_16_color_FFFFFF_t_70_pic_center 3]: /images/20221005/b55bea7ea93a4b3ba29c5ba29bab2470.png
[watermark_type_ZmFuZ3poZW5naGVpdGk_shadow_10_text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L2x1Y2t5NTEyMjI_size_16_color_FFFFFF_t_70_pic_center 4]: /images/20221005/93163e84c5b6408faade25bda62980e0.png
[watermark_type_ZmFuZ3poZW5naGVpdGk_shadow_10_text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L2x1Y2t5NTEyMjI_size_16_color_FFFFFF_t_70_pic_center 5]: /images/20221005/5948304498734bffb2fa94075ebb997b.png
[watermark_type_ZmFuZ3poZW5naGVpdGk_shadow_10_text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L2x1Y2t5NTEyMjI_size_16_color_FFFFFF_t_70_pic_center 6]: /images/20221005/40ffd81b80784a74994a486a9fb5bf5b.png
[watermark_type_ZmFuZ3poZW5naGVpdGk_shadow_10_text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L2x1Y2t5NTEyMjI_size_16_color_FFFFFF_t_70_pic_center 7]: /images/20221005/89813d7ac3734eb781f4117c1acce08f.png