Code: Select all
' Omit plngLeft & plngRight; they are used internally during recursion
Public Sub QuickSort(ByRef pvarArray As Variant, Optional ByVal plngLeft As Long, Optional ByVal plngRight As Long)
Dim lngFirst As Long
Dim lngLast As Long
Dim varMid As Variant
Dim varSwap As Variant
If plngRight = 0 Then
plngLeft = LBound(pvarArray)
plngRight = UBound(pvarArray)
End If
lngFirst = plngLeft
lngLast = plngRight
varMid = pvarArray((plngLeft + plngRight) \ 2)
Do
Do While pvarArray(lngFirst) < varMid And lngFirst < plngRight
lngFirst = lngFirst + 1
Loop
Do While varMid < pvarArray(lngLast) And lngLast > plngLeft
lngLast = lngLast - 1
Loop
If lngFirst <= lngLast Then
varSwap = pvarArray(lngFirst)
pvarArray(lngFirst) = pvarArray(lngLast)
pvarArray(lngLast) = varSwap
lngFirst = lngFirst + 1
lngLast = lngLast - 1
End If
Loop Until lngFirst > lngLast
If plngLeft < lngLast Then QuickSort pvarArray, plngLeft, lngLast
If lngFirst < plngRight Then QuickSort pvarArray, lngFirst, plngRight
End Sub
Code: Select all
' Simple binary search. Be sure array is sorted first.
' Returns index of first match, or -1 if no match found
Public Function BinarySearch(pvarArray As Variant, pvarFind As Variant) As Long
Dim lngFirst As Long
Dim lngMid As Long
Dim lngLast As Long
BinarySearch = -1
lngMid = -1
lngFirst = LBound(pvarArray)
lngLast = UBound(pvarArray)
Do While lngFirst <= lngLast
lngMid = (lngFirst + lngLast) \ 2
If pvarArray(lngMid) > pvarFind Then
lngLast = lngMid - 1
ElseIf pvarArray(lngMid) < pvarFind Then
lngFirst = lngMid + 1
Else
Exit Do
End If
Loop
' Make sure this is the first match in array
Do While lngMid > lngFirst
If pvarArray(lngMid - 1) <> pvarFind Then Exit Do
lngMid = lngMid - 1
Loop
' Set return value if match was found
If pvarArray(lngMid) = pvarFind Then BinarySearch = lngMid
End Function
Code: Select all
' Knuth shuffle (very fast)
Public Function ShuffleArray(pvarArray As Variant)
Dim i As Long
Dim iMin As Long
Dim iMax As Long
Dim lngReplace As Long
Dim varSwap As Variant
iMin = LBound(pvarArray)
iMax = UBound(pvarArray)
For i = iMax To iMin + 1 Step -1
lngReplace = Int((i - iMin + 1) * Rnd + iMin)
varSwap = pvarArray(i)
pvarArray(i) = pvarArray(lngReplace)
pvarArray(lngReplace) = varSwap
Next
End Function