VB and VBA Users Source Code: Sorting a 1d array
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Sorting a 1d array
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Thursday, March 29, 2001
Hits:
898
Category:
Visual Basic General
Article:
The following code can be used to rapdily sort a 1d array. 'Purpose : Sorts a 1D array. 'Inputs : avValues. The array to sort ' [lLowerBound] The lLowerBound of Array. NOT REQUIRED (USED IN RECURSIVE LOOP) ' [lUpperBound] The lUpperBound of Array. NOT REQUIRED (USED IN RECURSIVE LOOP) ' [bSortDescending ] If True sorts the array in descending order. Defaults to ascending. 'Outputs : avValues is sorted. 'Author : Andrew Baker 'Date : 25/03/2000 'Notes : The optional parameters are not required to be passed in. ' They are only required for the subsequent recursive calls. ' This type of sorting is much faster than "Bubble Sorting", especially ' if your items are order randomly. Sub Array1DSort(ByRef avValues As Variant, Optional lLowerBound As Long, Optional lUpperBound As Long, Optional ByVal bSortDescending As Boolean = False) Dim lTestLower As Long, lTestUpper As Long, vThisItem As Variant, vThisValue As Variant If lLowerBound = 0 Then lLowerBound = LBound(avValues) End If If lUpperBound = 0 Then lUpperBound = UBound(avValues) End If lTestLower = lLowerBound lTestUpper = lUpperBound vThisItem = avValues((lLowerBound + lUpperBound) / 2) If bSortDescending Then Do While (lTestLower <= lTestUpper) Do While (avValues(lTestLower) > vThisItem And lTestLower < lUpperBound) lTestLower = lTestLower + 1 Loop Do While (vThisItem > avValues(lTestUpper) And lTestUpper > lLowerBound) lTestUpper = lTestUpper - 1 Loop If (lTestLower <= lTestUpper) Then vThisValue = avValues(lTestLower) avValues(lTestLower) = avValues(lTestUpper) avValues(lTestUpper) = vThisValue lTestLower = lTestLower + 1 lTestUpper = lTestUpper - 1 End If Loop Else Do While (lTestLower <= lTestUpper) Do While (avValues(lTestLower) < vThisItem And lTestLower < lUpperBound) lTestLower = lTestLower + 1 Loop Do While (vThisItem < avValues(lTestUpper) And lTestUpper > lLowerBound) lTestUpper = lTestUpper - 1 Loop If (lTestLower <= lTestUpper) Then vThisValue = avValues(lTestLower) avValues(lTestLower) = avValues(lTestUpper) avValues(lTestUpper) = vThisValue lTestLower = lTestLower + 1 lTestUpper = lTestUpper - 1 End If Loop End If If (lLowerBound < lTestUpper) Then Array1DSort avValues, lLowerBound, lTestUpper, bSortDescending End If If (lTestLower < lUpperBound) Then Array1DSort avValues, lTestLower, lUpperBound, bSortDescending End If End Sub 'Demonstration routine Sub Test() Dim alValues(1 To 50) As Long, lThisRow As Long 'Create an array containg random numbers Randomize 'Initialize random-number generator For lThisRow = 1 To 50 alValues(lThisRow) = Int((1000 * Rnd) + 1) 'Generate a random number between 1 and 1000 Next 'Sort numbers Array1DSort alValues 'Display results For lThisRow = 1 To 50 Debug.Print alValues(lThisRow) Next End Sub
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
