Private Sub QuickSort(ByRef Values As Variant, Optional ByVal Left As Long, Optional ByVal Right As Long)
Dim I As Long
Dim J As Long
Dim K As Long
Dim Item1 As Variant
Dim Item2 As Variant
On Error GoTo Catch
If IsMissing(Left) Or Left = 0 Then Left = LBound(Values)
If IsMissing(Right) Or Right = 0 Then Right = UBound(Values)
I = Left
J = Right
Item1 = Values((Left + Right) \ 2, 2)
Do While I < J
Do While Values(I, 2) < Item1 And I < Right
I = I + 1
Loop
Do While Values(J, 2) > Item1 And J > Left
J = J - 1
Loop
If I < J Then
Call Swap(Values, I, J)
End If
If I <= J Then
I = I + 1
J = J - 1
End If
Loop
If J > Left Then Call QuickSort(Values, Left, J)
If I < Right Then Call QuickSort(Values, I, Right)
Exit Sub
Catch:
MsgBox Err.Description, vbCritical
End Sub
Private Sub Swap(ByRef Values As Variant, ByVal I As Long, ByVal J As Long)
Dim Temp1 As Double
Dim Temp2 As Double
Temp1 = Values(I, 1)
Temp2 = Values(I, 2)
Values(I, 1) = Values(J, 1)
Values(I, 2) = Values(J, 2)
Values(J, 1) = Temp1
Values(J, 2) = Temp2
End Sub
|