NDXShellsort



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



(ndxshellsort.html)- by Paolo Puglisi - Modifica del 25/3/2019