Browse DevX
Sign up for e-mail newsletters from DevX

Tip of the Day
Language: VB4,VB5,VB6,VBS
Expertise: Intermediate
Apr 27, 1999



Building the Right Environment to Support AI, Machine Learning and Deep Learning

ShellSort - Sort Arrays using the ShellSort Algorithm

' ShellSort an array of any type
' ShellSort behaves pretty well with arrays of any size, even
' if the array is already "nearly-sorted", even though in
' particular cases BubbleSort or QuickSort can be more efficient.
' LASTEL is the index of the last item to be sorted, and is
' useful if the array is only partially filled. This updated version accounts
' for arrays whose LBound is 0 and 1 (or whatever)
' Works with any kind of array, except UDTs and fixed-length
' strings, and including objects if your are sorting on their
' default property. String are sorted in case-sensitive mode.
' You can write faster procedures if you modify the first two lines
' to account for a specific data type, eg.
' Sub ShellSortS(arr() As Single, Optional lastEl As Variant,
'  Optional descending As Boolean)
'   Dim value As Single

Sub ShellSort(arr As Variant, Optional lastEl As Variant, _
    Optional descending As Boolean)
    Dim value As Variant
    Dim index As Long, index2 As Long
    Dim firstEl As Long
    Dim distance As Long
    Dim numEls As Long

    ' account for optional arguments
    If IsMissing(lastEl) Then lastEl = UBound(arr)
    firstEl = LBound(arr)
    numEls = lastEl - firstEl + 1
    ' find the best value for distance
        distance = distance * 3 + 1
    Loop Until distance > numEls

        distance = distance \ 3
        For index = distance + firstEl To lastEl
            value = arr(index)
            index2 = index
            Do While (arr(index2 - distance) > value) Xor descending
                arr(index2) = arr(index2 - distance)
                index2 = index2 - distance
                If index2 - distance < firstEl Then Exit Do
            arr(index2) = value
    Loop Until distance = 1
End Sub
Francesco Balena
Comment and Contribute






(Maximum characters: 1200). You have 1200 characters left.



Thanks for your registration, follow us on our social networks to keep up-to-date