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
联系客服