|
Sub NdxShellSort(arr As Variant, ndx() As Long, Optional numEls As Variant, _
Optional descending As Boolean) Dim value As Variant Dim index As Long, index2 As Long Dim firstItem As Long Dim distance As Long Dim tempNdx As Long ' account for optional arguments If IsMissing(numEls) Then numEls = UBound(arr) firstItem = LBound(arr) ' init index array if necessary If ndx(firstItem) = 0 And ndx(UBound(ndx)) = 0 Then For index = firstItem To UBound(ndx) ndx(index) = index Next End If ' find the best value for distance Do distance = distance * 3 + 1 Loop Until distance > numEls Do distance = distance \ 3 For index = distance + 1 To numEls tempNdx = ndx(index) value = arr(tempNdx) index2 = index Do While (arr(ndx(index2 - distance)) > value) Xor descending ndx(index2) = ndx(index2 - distance) index2 = index2 - distance If index2 <= distance Then Exit Do Loop ndx(index2) = tempNdx Next Loop Until distance = 1 End Sub |