-
Apr 10th, 2007, 08:05 PM
#1
Sorting & searching 2-dimensional arrays
EDIT: Though clever, this isn't an optimal implementation. All the cuteness with swapping out dimension references slows the whole thing down about 33%. For better performance, see this thread.
[/EDIT]
Here is a module you can add to your project if you need to sort and/or search a two dimensional array. Both the sort and search work on either dimension.
The module includes a test function for demonstration.
Code:
' Written by Ellis Dee
Option Explicit
Option Compare Text
Public Sub TestSort()
Dim lngRow As Long
Dim lngCol As Long
Dim MyArray() As Variant
Dim strFind As String
Randomize Timer
Debug.Print "Row, Column (Generally a fixed array)"
ReDim MyArray(10 To 20, 2 To 3)
For lngRow = LBound(MyArray, 1) To UBound(MyArray, 1)
MyArray(lngRow, 2) = Chr(Int((90 - 65 + 1) * Rnd + 65))
MyArray(lngRow, 3) = Int((199 - 100 + 1) * Rnd + 100)
Debug.Print lngRow & ": " & MyArray(lngRow, 2) & ", " & MyArray(lngRow, 3)
Next
QuickSort MyArray, 2, 2
Debug.Print "Sorted"
For lngRow = LBound(MyArray, 1) To UBound(MyArray, 1)
Debug.Print lngRow & ": " & MyArray(lngRow, 2) & ", " & MyArray(lngRow, 3)
Next
Debug.Print "Array index of first 'Q': " & BinarySearch(MyArray, 2, 2, "Q")
Debug.Print
Debug.Print "Column, Row (Generally a dynamic array)"
ReDim MyArray(2 To 3, 10 To 20)
For lngRow = LBound(MyArray, 2) To UBound(MyArray, 2)
MyArray(2, lngRow) = Chr(Int((90 - 65 + 1) * Rnd + 65))
MyArray(3, lngRow) = Int((199 - 100 + 1) * Rnd + 100)
Debug.Print lngRow & ": " & MyArray(2, lngRow) & ", " & MyArray(3, lngRow)
Next
QuickSort MyArray, 1, 2
Debug.Print "Sorted"
For lngRow = LBound(MyArray, 2) To UBound(MyArray, 2)
Debug.Print lngRow & ": " & MyArray(2, lngRow) & ", " & MyArray(3, lngRow)
Next
Debug.Print "Array index of first 'Q': " & BinarySearch(MyArray, 1, 2, "Q")
Erase MyArray
End Function
' Sort a 2-dimensional array on either dimension
' Omit plngLeft & plngRight; they are used internally during recursion
' Sample usage to sort on column 4
' Dim MyArray(1 to 1000, 1 to 5) As Long
' QuickSort MyArray, 2, 4
' Dim MyArray(1 to 5, 1 to 1000) As Long
' QuickSort MyArray, 1, 4
Public Sub QuickSort(pArray As Variant, pbytDimension As Byte, plngColumn As Long, Optional ByVal plngLeft As Long, Optional ByVal plngRight As Long)
Dim i As Long
Dim lngFirst As Long
Dim lngLast As Long
Dim vFirst As Variant
Dim vMid As Variant
Dim vLast As Variant
Dim lDim(1 To 2) As Long
Dim bytCol As Byte
Dim bytRow As Byte
bytRow = -pbytDimension + 3
bytCol = pbytDimension
If plngRight = 0 Then
plngLeft = LBound(pArray, bytRow)
plngRight = UBound(pArray, bytRow)
End If
lngFirst = plngLeft
lngLast = plngRight
lDim(bytRow) = (plngLeft + plngRight) \ 2
lDim(bytCol) = plngColumn
vMid = pArray(lDim(1), lDim(2))
Do
lDim(bytRow) = lngFirst
lDim(bytCol) = plngColumn
Do While pArray(lDim(1), lDim(2)) < vMid And lngFirst < plngRight
lngFirst = lngFirst + 1
lDim(bytRow) = lngFirst
Loop
lDim(bytRow) = lngLast
Do While vMid < pArray(lDim(1), lDim(2)) And lngLast > plngLeft
lngLast = lngLast - 1
lDim(bytRow) = lngLast
Loop
If lngFirst <= lngLast Then
For i = LBound(pArray, bytCol) To UBound(pArray, bytCol)
lDim(bytCol) = i
lDim(bytRow) = lngFirst
vFirst = pArray(lDim(1), lDim(2))
lDim(bytRow) = lngLast
vLast = pArray(lDim(1), lDim(2))
pArray(lDim(1), lDim(2)) = vFirst
lDim(bytRow) = lngFirst
pArray(lDim(1), lDim(2)) = vLast
Next
lngFirst = lngFirst + 1
lngLast = lngLast - 1
End If
Loop Until lngFirst > lngLast
If plngLeft < lngLast Then QuickSort pArray, pbytDimension, plngColumn, plngLeft, lngLast
If lngFirst < plngRight Then QuickSort pArray, pbytDimension, plngColumn, lngFirst, plngRight
End Sub
' Simple binary search. Be sure array is sorted first.
' Sample usage to locate ID from column 1
' Dim MyArray(1 to 1000, 1 to 5) As Long
' lngIndex = BinarySearch(MyArray, 2, 1, lngIDToFind)
' Dim MyArray(1 to 5, 1 to 1000) As Long
' lngIndex = BinarySearch(MyArray, 1, 1, lngIDToFind)
Public Function BinarySearch(pArray As Variant, pbytDimension As Byte, plngColumn As Long, pvarFind As Variant) As Long
Dim lngFirst As Long
Dim lngMid As Long
Dim lngLast As Long
Dim lDim(1 To 2) As Long
Dim bytCol As Byte
Dim bytRow As Byte
bytRow = -pbytDimension + 3
bytCol = pbytDimension
lDim(bytCol) = plngColumn
BinarySearch = -1
lngMid = -1
lngFirst = LBound(pArray, bytRow)
lngLast = UBound(pArray, bytRow)
Do While lngFirst <= lngLast
lngMid = (lngFirst + lngLast) \ 2
lDim(bytRow) = lngMid
If pArray(lDim(1), lDim(2)) > pvarFind Then
lngLast = lngMid - 1
ElseIf pArray(lDim(1), lDim(2)) < pvarFind Then
lngFirst = lngMid + 1
Else
Exit Do
End If
Loop
' Make sure this is the first match in array
Do While lngMid > lngFirst
lDim(bytRow) = lngMid - 1
If pArray(lDim(1), lDim(2)) <> pvarFind Then Exit Do
lngMid = lngMid - 1
Loop
' Set return value if match was found
If lngMid > -1 Then
lDim(bytRow) = lngMid
If pArray(lDim(1), lDim(2)) = pvarFind Then BinarySearch = lngMid
End If
End Function
Last edited by Ellis Dee; Jun 12th, 2007 at 09:39 PM.
-
Mar 23rd, 2010, 06:47 AM
#2
Addicted Member
Re: Sorting & searching 2-dimensional arrays
that is great, thanks
Just a little question:
in case i called the quicksort function to sort column 2, and in the array, one of the column 2 is having null value, what would be the sorting result? the "NULL" value would be sorted to the first row or the last row?
I can still live in my current job because I am here
-
Mar 24th, 2010, 02:00 AM
#3
Re: Sorting & searching 2-dimensional arrays
Not sure, since doing a comparison on NULL returns NULL. Could go either way. Try it and see.
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|