[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