[AccessD] is there an app for ththe is?

Gustav Brock gustav at cactus.dk
Mon Oct 25 06:26:00 CDT 2021


Hi Arthur

Don't overdo that. In fact, a sub can allow for very clean code. 
Take this example (the test at bottom):

<code>
' Quickly sort a Variant array.
'
' The array does not have to be zero- or one-based.
'
' 2018-03-16. Gustav Brock, Cactus Data ApS, CPH.
'
Public Sub QuickSort(ByRef Values As Variant)

    Dim Lows()      As Variant
    Dim Mids()      As Variant
    Dim Tops()      As Variant
    Dim Pivot       As Variant
    Dim Lower       As Long
    Dim Upper       As Long
    Dim UpperLows   As Long
    Dim UpperMids   As Long
    Dim UpperTops   As Long
    
    Dim Value       As Variant
    Dim Item        As Long
    Dim Index       As Long
 
    ' Find count of elements to sort.
    Lower = LBound(Values)
    Upper = UBound(Values)
    If Lower = Upper Then
        ' One element only.
        ' Nothing to do.
        Exit Sub
    End If
    
    
    ' Choose pivot in the middle of the array.
    Pivot = Values(Int((Upper - Lower) / 2) + Lower)
    ' Construct arrays.
    For Each Value In Values
        If Value < Pivot Then
            ReDim Preserve Lows(UpperLows)
            Lows(UpperLows) = Value
            UpperLows = UpperLows + 1
        ElseIf Value > Pivot Then
            ReDim Preserve Tops(UpperTops)
            Tops(UpperTops) = Value
            UpperTops = UpperTops + 1
        Else
            ReDim Preserve Mids(UpperMids)
            Mids(UpperMids) = Value
            UpperMids = UpperMids + 1
        End If
    Next
    
    ' Sort the two split arrays, Lows and Tops.
    If UpperLows > 0 Then
        QuickSort Lows()
    End If
    If UpperTops > 0 Then
        QuickSort Tops()
    End If
    
    ' Concatenate the three arrays and return Values.
    Item = 0
    For Index = 0 To UpperLows - 1
        Values(Lower + Item) = Lows(Index)
        Item = Item + 1
    Next
    For Index = 0 To UpperMids - 1
        Values(Lower + Item) = Mids(Index)
        Item = Item + 1
    Next
    For Index = 0 To UpperTops - 1
        Values(Lower + Item) = Tops(Index)
        Item = Item + 1
    Next

End Sub


' Demonstrates the usage of function QuickSort.
'
' 2018-03-16. Gustav Brock, Cactus Data ApS, CPH.
'
Public Sub QuickSortTest()

    Dim Samples(1 To 26)    As Variant
    Dim Item                As Long
 
    ' Populate Samples with numbers in descending order.
    For Item = 1 To 26: Samples(Item) = 26 - Item: Next
    For Item = 1 To 26: Debug.Print Samples(Item);: Next
    Debug.Print
    
    ' Sort ascending.
    QuickSort Samples()
    For Item = 1 To 26: Debug.Print Samples(Item);: Next
    Debug.Print
    
    ' Populate Samples with strings in descending order.
    For Item = 1 To 26: Samples(Item) = Chr(Asc("z") + 1 - Item) & "-item": Next
    For Item = 1 To 26: Debug.Print Samples(Item); " ";: Next
    Debug.Print
    
    ' Sort ascending.
    QuickSort Samples()
    For Item = 1 To 26: Debug.Print Samples(Item); " ";: Next
    Debug.Print

End Sub
</code>

>From module ArraySorting at https://github.com/GustavBrock/VBA.Round

/gustav

-----Oprindelig meddelelse-----
Fra: AccessD <accessd-bounces+gustav=cactus.dk at databaseadvisors.com> På vegne af Arthur Fuller
Sendt: 25. oktober 2021 12:12
Til: Access Developers discussion and problem solving <accessd at databaseadvisors.com>
Emne: Re: [AccessD] is there an app for ththe is?

I don't go ass far as you do, Stuart, but I think I will adopt this practice immediatey. Thanks for the tip.
<snip> 


More information about the AccessD mailing list