Sort_TwoDimensionBubble

Sorts a 2-dimensional array

Original Author: Gordon Fuller

Inputs

TempArray Variant
iElement Integer
iDimension Integer
bAscOrder Boolean

Assumptions

Best used for smaller arrays, since the bubblesort algorithm is not suited to very large arrays

Returns

Boolean if the sort was successful

Code

'?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?� ' Name: Sort_TwoDimensionBubble ' VB Version: 6.00 ' Called by: Procedures Events ' ---------- ------ ' ' Author: Gordon McI. Fuller ' Copyright: ?�2000 Force 10 Automation ' Created: Friday, March 17, 2000 ' Modified: [Friday, March 17, 2000] ' Purpose: ' Inputs: Param Name Type Meaning ' ----- ---- ---- ------- ' TempArray Variant ' Optional iElement Integer ' Optional iDimension Integer = 1 ' Optional bAscOrder Boolean = True ' Returns: True/False for success of the sort ' Global Used: ' Module used: '------------------------------------------------------------ ' Notes: This is a bubble sort ' For large arrays it may not be the most efficient ' option, but I haven't found anything in a ' multi-dimension sort using another algorithm. ' ' Sample array array(0,0) = Apples ' array(0,1) = 5 ' array(0,2) = Tree ' array(1,0) = Grapes ' ... ' Apples 5 Tree ' Grapes 2 Vine ' Pears 3 Tree ' The iDimension is 1 because it am sorting by the "rows" of the ' first dimension rather than the "columns" of the 2nd ' Since we would want to sort by the numeric value, ' the iElement variable is 1 ' bAscOrder indicates whether the sort order is ascending or descending ' ' If the array were structured as ' array(0,0) = "Apples" ' array(1,0) = 5 ' array(2,0) = Tree ' ... ' Apples Grapes Tree ' 5 2 3 ' Tree Vine Tree ' iDimension will be 2 since we are sorting on the "columns" ' iElement will still be 1 since we are sorting by that numeric value '?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?�?� Function Sort_TwoDimensionBubble(TempArray As Variant, _ Optional iElement As Integer = 1, _ Optional iDimension As Integer = 1, _ Optional bAscOrder As Boolean = True) As Boolean Dim arrTemp As Variant Dim i%, j% Dim NoExchanges As Integer On Error GoTo Error_BubbleSort ' Loop until no more "exchanges" are made. If iDimension% = 1 Then ReDim arrTemp(1, UBound(TempArray, 2)) Else ReDim arrTemp(UBound(TempArray, 1), 1) End If Do NoExchanges = True ' Loop through each element in the array. If iDimension% = 1 Then For i% = LBound(TempArray, iDimension%) To UBound(TempArray, iDimension%) - 1 ' If the element is greater than the element ' following it, exchange the two elements. If (bAscOrder And (TempArray(i%, iElement%) > TempArray(i% + 1, iElement%))) _ Or (Not bAscOrder And (TempArray(i%, iElement%) < TempArray(i% + 1, iElement%))) _ Then NoExchanges = False For j% = LBound(TempArray, 2) To UBound(TempArray, 2) arrTemp(1, j%) = TempArray(i%, j%) Next j% For j% = LBound(TempArray, 2) To UBound(TempArray, 2) TempArray(i%, j%) = TempArray(i% + 1, j%) Next j% For j% = LBound(TempArray, 2) To UBound(TempArray, 2) TempArray(i% + 1, j%) = arrTemp(1, j%) Next j% End If Next i% Else For i% = LBound(TempArray, iDimension%) To UBound(TempArray, iDimension%) - 1 ' If the element is greater than the element ' following it, exchange the two elements. If (bAscOrder And (TempArray(iElement%, i%) > TempArray(iElement%, i% + 1))) _ Or (Not bAscOrder And (TempArray(iElement%, i%) < TempArray(iElement%, i% + 1))) _ Then NoExchanges = False For j% = LBound(TempArray, 1) To UBound(TempArray, 1) arrTemp(j%, 1) = TempArray(j%, i%) Next j% For j% = LBound(TempArray, 1) To UBound(TempArray, 1) TempArray(j%, i%) = TempArray(j%, i% + 1) Next j% For j% = LBound(TempArray, 1) To UBound(TempArray, 1) TempArray(j%, i% + 1) = arrTemp(j%, 1) Next j% End If Next i% End If Loop While Not (NoExchanges) Sort_TwoDimensionBubble = True On Error GoTo 0 Exit Function Error_BubbleSort: On Error GoTo 0 Sort_TwoDimensionBubble = False End Function

About this post

Posted: 2002-06-01
By: ArchiveBot
Viewed: 104 times

Comments

No comments have been added for this post.

You must be logged in to make a comment.