|
Visual Basic (VB and VBA) |
|
Copyright 1999-2001 Christopher Greaves. All rights reserved. Home Page and email to [email protected] |
| If in doubt, record a macro and inspect the entrails! |
Please read the DISCLAIMER.
Here is an INDEX to all the procedures.
You will probably need one copy of my GLOBAL DECLARATIONS.
Public Function QSort(strList() As String, ByVal lLbound As Long, ByVal lUbound As Long, ByVal boolCaseSensitive As Boolean)
'::: Routine:QSort :::'
'::: Author:Mike Shaffer (after Rod Stephens, et al.) :::'
'::: Date: 21-May-98 :::'
'::: Purpose:Very fast sort of a string array :::'
'::: Passed:strListString array:::'
'::: lLboundLower bound to sort (usually 1) :::'
'::: lUboundUpper bound to sort (usually ubound()) :::'
'::: Returns:strList(in sorted order):::'
'::: Copyright: Copyright *c* 1998, Mike Shaffer :::'
'::: ALL RIGHTS RESERVED WORLDWIDE :::'
'::: Permission granted to use in any non-commercial:::'
'::: product with credit where due. For free:::'
'::: commercial license contact [email protected]:::'
'::: Revisions: 22-May-98 Added and then dropped revision :::'
'::: using CopyMemory rather than the simple swap :::'
'::: when it was found to not provide much benefit.:::'
Dim strTemp As String
Dim strBuffer As String
Dim lngCurLow As Long
Dim lngCurHigh As Long
Dim lngCurMidpoint As Long
' boolCS = boolCaseSensitive
lngCurLow = lLbound ' Start current low and high at actual low/high
lngCurHigh = lUbound
If lUbound <= lLbound Then Exit Function ' Error!
lngCurMidpoint = (lLbound + lUbound) \ 2 ' Find the approx midpoint of the array
strTemp = MyUCase(strList(lngCurMidpoint), boolCaseSensitive) ' Pick as a starting point (we are making
' an assumption that the data *might* be in semi-sorted order already!
Do While (lngCurLow <= lngCurHigh)
Do While MyUCase(strList(lngCurLow), boolCaseSensitive) < strTemp
lngCurLow = lngCurLow + 1
If lngCurLow = lUbound Then Exit Do
Loop
Do While strTemp < MyUCase(strList(lngCurHigh), boolCaseSensitive)
lngCurHigh = lngCurHigh - 1
If lngCurHigh = lLbound Then Exit Do
Loop
If (lngCurLow <= lngCurHigh) Then ' if low is <= high then swap
strBuffer = strList(lngCurLow)
strList(lngCurLow) = strList(lngCurHigh)
strList(lngCurHigh) = strBuffer
lngCurLow = lngCurLow + 1 ' CurLow++
lngCurHigh = lngCurHigh - 1 ' CurLow--
End If
Loop
If lLbound < lngCurHigh Then ' Recurse if necessary
QSort strList(), lLbound, lngCurHigh, boolCaseSensitive
End If
If lngCurLow < lUbound Then ' Recurse if necessary
QSort strList(), lngCurLow, lUbound, boolCaseSensitive
End If
'Sub TESTQSort()
'Dim strList(10) As String
'Dim i As Integer
'strList(0) = "alpha"
'strList(1) = "strList"
'strList(2) = "lLbound"
'strList(3) = "lngCurHigh"
'strList(4) = "End"
'strList(5) = "If"
'strList(6) = "QSort"
'strList(7) = "Function"
'strList(8) = "lngCurLow"
'strList(9) = "strBuffer"
'strList(10) = "swap"
''For i = 0 To 10
'' Debug.Print strList(i)
''Next i
'Call QSort(strList, 0, 10, False)
'For i = 0 To 10
' Debug.Print strList(i)
'Next i
'End Sub
End Function
| We all knew nothing when we started … |
|
Home Page and Contact Information Send email to [email protected]. This page was last updated Thursday, November 15, 2001 |