VB版快速排序算法代码

更多 0

Option Explicit' a position, which is *hopefully* never used:Public Const N_POS = -2147483648#Public Sub Swap(ByRef Data() As Variant, _                Index1 As Long, _                Index2 As Long)    If Index1 <> Index2 Then        Dim tmp As Variant        If IsObject(Data(Index1)) Then            Set tmp = Data(Index1)        Else            tmp = Data(Index1)        End If        If IsObject(Data(Index2)) Then            Set Data(Index1) = Data(Index2)        Else            Data(Index1) = Data(Index2)        End If        If IsObject(tmp) Then            Set Data(Index2) = tmp        Else            Data(Index2) = tmp        End If        Set tmp = Nothing    End IfEnd SubPublic Sub QuickSort(ByRef Data() As Variant, _                     Optional ByVal Lower As Long = N_POS, _                     Optional ByVal Upper As Long = N_POS)    If Lower = N_POS Then        Lower = LBound(Data)    End If    If Upper = N_POS Then        Upper = UBound(Data)    End If    If Lower < Upper Then        Dim Right As Long        Dim Left  As Long        Left = Lower + 1        Right = Upper + 1        Do While Left < Right            If Data(Left) <= Data(Lower) Then                Left = Left + 1            Else                Right = Right - 1                Swap Data, Left, Right            End If        Loop        Left = Left - 1        Swap Data, Lower, Left        QuickSort Data, Lower, Left - 1        QuickSort Data, Right, Upper    End IfEnd Sub

                                另外一个版本

Function Quicksort(ByRef aData() As Long) As Long()    Dim lPivot As Long    Dim aLesser() As Long    Dim aPivotList() As Long    Dim aBigger() As Long    Dim i As Long    Dim count As Long    Dim ret() As Long    On Error Resume Next    count = UBound(aData)    If Err Then        Exit Function    ElseIf count = 0 Then        Quicksort = aData        Exit Function    End If    On Error GoTo 0    Randomize    lPivot = aData(Int(Rnd * count))    For i = 0 To count        If aData(i) < lPivot Then AddTo aData(i), aLesser        If aData(i) = lPivot Then AddTo aData(i), aPivotList        If aData(i) > lPivot Then AddTo aData(i), aBigger    Next    aLesser = Quicksort(aLesser)    aPivotList = aPivotList    aBigger = Quicksort(aBigger)    ret = JoinLists(aLesser, aPivotList, aBigger)    Quicksort = retEnd FunctionSub AddTo(ByVal lData As Long, ByRef aWhere() As Long)    Dim count As Long    On Error Resume Next    count = UBound(aWhere) + 1    ReDim Preserve aWhere(count)    aWhere(count) = lData    On Error GoTo 0End SubFunction JoinLists(ByRef Arr1() As Long, ByRef Arr2() As Long, ByRef Arr3() As Long) As Long()    Dim count1 As Long    Dim count2 As Long    Dim count3 As Long    Dim i As Long    Dim ret() As Long    Dim cnt As Long    On Error Resume Next    Err.Clear    count1 = UBound(Arr1)    If Err Then count1 = -1    Err.Clear    count2 = UBound(Arr2)    If Err Then count2 = -1    Err.Clear    count3 = UBound(Arr3)    If Err Then count3 = -1    Err.Clear    On Error GoTo 0    ReDim ret(count1 + (count2 + 1) + (count3 + 1))    For i = 0 To count1        ret(i) = Arr1(i)    Next    For i = count1 + 1 To (count2 + 1) + count1        ret(i) = Arr2(i - count1 - 1)    Next    For i = count2 + 1 + count1 + 1 To (count3 + 1) + (count2 + 1) + count1        ret(i) = Arr3(i - count2 - 1 - count1 - 1)    Next    JoinLists = retEnd Function

本站仅提供存储服务，所有内容均由用户发布，如发现有害或侵权内容，请点击举报。