XLA routines: EE_SortArray
EE_SortArray does what it says on the tin: Sorts an array
Function EE_SortArray(ArrayToSort, Optional descending As Boolean) '- takes array '- sorts it Dim value As Variant, temp As Variant Dim sp As Integer Dim leftStk(32) As Long, rightStk(32) As Long Dim leftNdx As Long, rightNdx As Long Dim i As Long, j As Long Dim numEls 'http://excelexperts.com/xla-routines-eeSortArray for updates on this function ' account for optional arguments numEls = UBound(ArrayToSort) ' init pointers leftNdx = LBound(ArrayToSort) rightNdx = numEls ' init stack sp = 1 leftStk(sp) = leftNdx rightStk(sp) = rightNdx Do If rightNdx > leftNdx Then value = ArrayToSort(rightNdx) i = leftNdx - 1 j = rightNdx ' find the pivot item If descending Then Do Do: i = i + 1: Loop Until ArrayToSort(i) <= value Do: j = j - 1: Loop Until j = leftNdx Or ArrayToSort(j) >= value temp = ArrayToSort(i) ArrayToSort(i) = ArrayToSort(j) ArrayToSort(j) = temp Loop Until j <= i Else Do Do: i = i + 1: Loop Until ArrayToSort(i) >= value Do: j = j - 1: Loop Until j = leftNdx Or ArrayToSort(j) <= value temp = ArrayToSort(i) ArrayToSort(i) = ArrayToSort(j) ArrayToSort(j) = temp Loop Until j <= i End If ' swap found items temp = ArrayToSort(j) ArrayToSort(j) = ArrayToSort(i) ArrayToSort(i) = ArrayToSort(rightNdx) ArrayToSort(rightNdx) = temp ' push on the stack the pair of pointers that differ most sp = sp + 1 If (i - leftNdx) > (rightNdx - i) Then leftStk(sp) = leftNdx rightStk(sp) = i - 1 leftNdx = i + 1 Else leftStk(sp) = i + 1 rightStk(sp) = rightNdx rightNdx = i - 1 End If Else ' pop a new pair of pointers off the stacks leftNdx = leftStk(sp) rightNdx = rightStk(sp) sp = sp - 1 If sp = 0 Then Exit Do End If Loop EE_SortArray = ArrayToSort End Function
»
- Nick's blog
- Login or register to post comments
- 2670 reads
Recent comments
5 years 36 weeks ago
6 years 22 weeks ago
6 years 34 weeks ago
6 years 37 weeks ago
6 years 38 weeks ago
6 years 43 weeks ago
6 years 52 weeks ago
7 years 2 days ago
7 years 3 days ago
7 years 3 days ago