' qsort Public Sub QSort(ByRef A() As Variant, ByVal Lb As Long, ByVal Ub As Long) Dim lbStack(32) As Long Dim ubStack(32) As Long Dim sp As Long ' stack pointer Dim lbx As Long ' current lower-bound Dim ubx As Long ' current upper-bound Dim m As Long Dim p As Long ' index to pivot Dim i As Long Dim j As Long Dim t As Variant ' temp used for exchanges lbStack(0) = Lb ubStack(0) = Ub sp = 0 Do While sp >= 0 lbx = lbStack(sp) ubx = ubStack(sp) Do While (lbx < ubx) ' select pivot and exchange with 1st element p = lbx + (ubx - lbx) \ 2 ' exchange lbx, p t = A(lbx) A(lbx) = A(p) A(p) = t ' partition into two segments i = lbx + 1 j = ubx Do Do While i < j If A(lbx) <= A(i) Then Exit Do i = i + 1 Loop Do While j >= i If A(j) <= A(lbx) Then Exit Do j = j - 1 Loop If i >= j Then Exit Do ' exchange i, j t = A(i) A(i) = A(j) A(j) = t j = j - 1 i = i + 1 Loop ' pivot belongs in A[j] ' exchange lbx, j t = A(lbx) A(lbx) = A(j) A(j) = t m = j ' keep processing smallest segment, and stack largest If m - lbx <= ubx - m Then If m + 1 < ubx Then lbStack(sp) = m + 1 ubStack(sp) = ubx sp = sp + 1 End If ubx = m - 1 Else If m - 1 > lbx Then lbStack(sp) = lbx ubStack(sp) = m - 1 sp = sp + 1 End If lbx = m + 1 End If Loop sp = sp - 1 Loop End Sub