快速排序法 QuickSort

 

Attribute VB_Name = "Module4"
'快速排序法
Private Function QuickSort(ArrayToSort() As String) As Boolean
    IterateSort ArrayToSort, LBound(ArrayToSort()), UBound(ArrayToSort())
End Function

'快速排序法
 Sub IterateSort(ArrayToSort() As String, ByVal StartElement As Long, ByVal EndElement As Long)
    Dim HoldValue As String
    Dim WorkEnd As Long, WorkStart As Long, RandomPoint As Long
    Dim SortOK As Boolean

    If EndElement <= StartElement Then '溢出
        Exit Sub
    End If

    WorkStart = StartElement
    WorkEnd = EndElement
    RandomPoint = Int((WorkEnd - WorkStart + 1) * Rnd + WorkStart)
    HoldValue = ArrayToSort(RandomPoint)
    ArrayToSort(RandomPoint) = ArrayToSort(WorkStart)
    SortOK = True
    Do While SortOK
        Do While ArrayToSort(WorkEnd) >= HoldValue
            WorkEnd = WorkEnd - 1
            If WorkEnd <= WorkStart Then
                Exit Do
            End If
        Loop
        If WorkEnd <= WorkStart Then
            ArrayToSort(WorkStart) = HoldValue
            Exit Do
        End If

        ' 交换
        ArrayToSort(WorkStart) = ArrayToSort(WorkEnd)
        WorkStart = WorkStart + 1
        Do While ArrayToSort(WorkStart) < HoldValue
            WorkStart = WorkStart + 1
            If WorkStart >= WorkEnd Then
                Exit Do
            End If
        Loop
        If WorkStart >= WorkEnd Then
            WorkStart = WorkEnd
            ArrayToSort(WorkEnd) = HoldValue
            Exit Do
        End If
        ArrayToSort(WorkEnd) = ArrayToSort(WorkStart)
    Loop
    IterateSort ArrayToSort(), StartElement, (WorkStart - 1)
    IterateSort ArrayToSort(), (WorkStart + 1), EndElement
End Sub