ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Quicksort for multi-columns (https://www.excelbanter.com/excel-programming/428251-quicksort-multi-columns.html)

Joakim Norrman[_2_]
Quicksort for multi-columns
 
I want to sort a 2D-array. I have found Quicksort code but only for a
one-dimensional array. Do anyone know where to find a sort routine for
2D-arrays? I want a quick method. Not Bubble sort.

RB Smissaert
Quicksort for multi-columns
 
Try this one:

Function QuickSort2DArray(VarArray As Variant, _
lSortColumn As Long, _
Optional sOrder As String = "A", _
Optional lngFirst As Long = -1, _
Optional lngLast As Long = -1) As Variant

Dim lngLow As Long
Dim lngHigh As Long
Dim lngMiddle As Long
Dim varTempVal As Variant
Dim varTestVal As Variant

If lngFirst = -1 Then lngFirst = LBound(VarArray)
If lngLast = -1 Then lngLast = UBound(VarArray)

lngMiddle = (lngFirst + lngLast) / 2
varTestVal = VarArray(lngMiddle, lSortColumn)
lngLow = lngFirst
lngHigh = lngLast

Do
If sOrder = "A" Then
Do While VarArray(lngLow, lSortColumn) < varTestVal
lngLow = lngLow + 1
Loop
Do While VarArray(lngHigh, lSortColumn) varTestVal
lngHigh = lngHigh - 1
Loop
Else
Do While VarArray(lngLow, lSortColumn) varTestVal
lngLow = lngLow + 1
Loop
Do While VarArray(lngHigh, lSortColumn) < varTestVal
lngHigh = lngHigh - 1
Loop
End If

If (lngLow <= lngHigh) Then
varTempVal = VarArray(lngLow, lSortColumn)
VarArray(lngLow, 1) = VarArray(lngHigh, lSortColumn)
VarArray(lngHigh, 1) = varTempVal
lngLow = lngLow + 1
lngHigh = lngHigh - 1
End If
Loop While (lngLow <= lngHigh)

If lngFirst < lngHigh Then QuickSort2DArray VarArray, lSortColumn, sOrder,
lngFirst, lngHigh
If lngLow < lngLast Then QuickSort2DArray VarArray, lSortColumn, sOrder,
lngLow, lngLast

End Function


RBS


"Joakim Norrman" wrote in message
...
I want to sort a 2D-array. I have found Quicksort code but only for a
one-dimensional array. Do anyone know where to find a sort routine for
2D-arrays? I want a quick method. Not Bubble sort.


RB Smissaert
Quicksort for multi-columns
 
I had quickly edited a bit of code and forgot to alter something else.
This is how it should be:

Function QuickSort2DArray(VarArray As Variant, _
lSortColumn As Long, _
Optional sOrder As String = "A", _
Optional lngFirst As Long = -1, _
Optional lngLast As Long = -1) As Variant

Dim c As Long
Dim lngLow As Long
Dim lngHigh As Long
Dim lngMiddle As Long
Dim varTempVal As Variant
Dim varTestVal As Variant

If lngFirst = -1 Then lngFirst = LBound(VarArray)
If lngLast = -1 Then lngLast = UBound(VarArray)

lngMiddle = (lngFirst + lngLast) / 2
varTestVal = VarArray(lngMiddle, lSortColumn)
lngLow = lngFirst
lngHigh = lngLast

Do
If sOrder = "A" Then
Do While VarArray(lngLow, lSortColumn) < varTestVal
lngLow = lngLow + 1
Loop
Do While VarArray(lngHigh, lSortColumn) varTestVal
lngHigh = lngHigh - 1
Loop
Else
Do While VarArray(lngLow, lSortColumn) varTestVal
lngLow = lngLow + 1
Loop
Do While VarArray(lngHigh, lSortColumn) < varTestVal
lngHigh = lngHigh - 1
Loop
End If

If (lngLow <= lngHigh) Then
'swap the array rows
'-------------------
For c = LBound(VarArray, 2) To UBound(VarArray, 2)
varTempVal = VarArray(lngLow, c)
VarArray(lngLow, c) = VarArray(lngHigh, c)
VarArray(lngHigh, c) = varTempVal
Next c

lngLow = lngLow + 1
lngHigh = lngHigh - 1
End If

Loop While (lngLow <= lngHigh)

If lngFirst < lngHigh Then
QuickSort2DArray VarArray, _
lSortColumn, _
sOrder, _
lngFirst, _
lngHigh
End If

If lngLow < lngLast Then
QuickSort2DArray VarArray, _
lSortColumn, _
sOrder, _
lngLow, _
lngLast
End If

End Function


RBS



"RB Smissaert" wrote in message
...
Try this one:

Function QuickSort2DArray(VarArray As Variant, _
lSortColumn As Long, _
Optional sOrder As String = "A", _
Optional lngFirst As Long = -1, _
Optional lngLast As Long = -1) As Variant

Dim lngLow As Long
Dim lngHigh As Long
Dim lngMiddle As Long
Dim varTempVal As Variant
Dim varTestVal As Variant

If lngFirst = -1 Then lngFirst = LBound(VarArray)
If lngLast = -1 Then lngLast = UBound(VarArray)

lngMiddle = (lngFirst + lngLast) / 2
varTestVal = VarArray(lngMiddle, lSortColumn)
lngLow = lngFirst
lngHigh = lngLast

Do
If sOrder = "A" Then
Do While VarArray(lngLow, lSortColumn) < varTestVal
lngLow = lngLow + 1
Loop
Do While VarArray(lngHigh, lSortColumn) varTestVal
lngHigh = lngHigh - 1
Loop
Else
Do While VarArray(lngLow, lSortColumn) varTestVal
lngLow = lngLow + 1
Loop
Do While VarArray(lngHigh, lSortColumn) < varTestVal
lngHigh = lngHigh - 1
Loop
End If

If (lngLow <= lngHigh) Then
varTempVal = VarArray(lngLow, lSortColumn)
VarArray(lngLow, 1) = VarArray(lngHigh, lSortColumn)
VarArray(lngHigh, 1) = varTempVal
lngLow = lngLow + 1
lngHigh = lngHigh - 1
End If
Loop While (lngLow <= lngHigh)

If lngFirst < lngHigh Then QuickSort2DArray VarArray, lSortColumn,
sOrder, lngFirst, lngHigh
If lngLow < lngLast Then QuickSort2DArray VarArray, lSortColumn, sOrder,
lngLow, lngLast

End Function


RBS


"Joakim Norrman" wrote in
message ...
I want to sort a 2D-array. I have found Quicksort code but only for a
one-dimensional array. Do anyone know where to find a sort routine for
2D-arrays? I want a quick method. Not Bubble sort.

Joakim Norrman[_2_]
Quicksort for multi-columns
 
Thanks RB. Appreciate your help.

"RB Smissaert" wrote:

I had quickly edited a bit of code and forgot to alter something else.
This is how it should be:

Function QuickSort2DArray(VarArray As Variant, _
lSortColumn As Long, _
Optional sOrder As String = "A", _
Optional lngFirst As Long = -1, _
Optional lngLast As Long = -1) As Variant

Dim c As Long
Dim lngLow As Long
Dim lngHigh As Long
Dim lngMiddle As Long
Dim varTempVal As Variant
Dim varTestVal As Variant

If lngFirst = -1 Then lngFirst = LBound(VarArray)
If lngLast = -1 Then lngLast = UBound(VarArray)

lngMiddle = (lngFirst + lngLast) / 2
varTestVal = VarArray(lngMiddle, lSortColumn)
lngLow = lngFirst
lngHigh = lngLast

Do
If sOrder = "A" Then
Do While VarArray(lngLow, lSortColumn) < varTestVal
lngLow = lngLow + 1
Loop
Do While VarArray(lngHigh, lSortColumn) varTestVal
lngHigh = lngHigh - 1
Loop
Else
Do While VarArray(lngLow, lSortColumn) varTestVal
lngLow = lngLow + 1
Loop
Do While VarArray(lngHigh, lSortColumn) < varTestVal
lngHigh = lngHigh - 1
Loop
End If

If (lngLow <= lngHigh) Then
'swap the array rows
'-------------------
For c = LBound(VarArray, 2) To UBound(VarArray, 2)
varTempVal = VarArray(lngLow, c)
VarArray(lngLow, c) = VarArray(lngHigh, c)
VarArray(lngHigh, c) = varTempVal
Next c

lngLow = lngLow + 1
lngHigh = lngHigh - 1
End If

Loop While (lngLow <= lngHigh)

If lngFirst < lngHigh Then
QuickSort2DArray VarArray, _
lSortColumn, _
sOrder, _
lngFirst, _
lngHigh
End If

If lngLow < lngLast Then
QuickSort2DArray VarArray, _
lSortColumn, _
sOrder, _
lngLow, _
lngLast
End If

End Function


RBS



"RB Smissaert" wrote in message
...
Try this one:

Function QuickSort2DArray(VarArray As Variant, _
lSortColumn As Long, _
Optional sOrder As String = "A", _
Optional lngFirst As Long = -1, _
Optional lngLast As Long = -1) As Variant

Dim lngLow As Long
Dim lngHigh As Long
Dim lngMiddle As Long
Dim varTempVal As Variant
Dim varTestVal As Variant

If lngFirst = -1 Then lngFirst = LBound(VarArray)
If lngLast = -1 Then lngLast = UBound(VarArray)

lngMiddle = (lngFirst + lngLast) / 2
varTestVal = VarArray(lngMiddle, lSortColumn)
lngLow = lngFirst
lngHigh = lngLast

Do
If sOrder = "A" Then
Do While VarArray(lngLow, lSortColumn) < varTestVal
lngLow = lngLow + 1
Loop
Do While VarArray(lngHigh, lSortColumn) varTestVal
lngHigh = lngHigh - 1
Loop
Else
Do While VarArray(lngLow, lSortColumn) varTestVal
lngLow = lngLow + 1
Loop
Do While VarArray(lngHigh, lSortColumn) < varTestVal
lngHigh = lngHigh - 1
Loop
End If

If (lngLow <= lngHigh) Then
varTempVal = VarArray(lngLow, lSortColumn)
VarArray(lngLow, 1) = VarArray(lngHigh, lSortColumn)
VarArray(lngHigh, 1) = varTempVal
lngLow = lngLow + 1
lngHigh = lngHigh - 1
End If
Loop While (lngLow <= lngHigh)

If lngFirst < lngHigh Then QuickSort2DArray VarArray, lSortColumn,
sOrder, lngFirst, lngHigh
If lngLow < lngLast Then QuickSort2DArray VarArray, lSortColumn, sOrder,
lngLow, lngLast

End Function


RBS


"Joakim Norrman" wrote in
message ...
I want to sort a 2D-array. I have found Quicksort code but only for a
one-dimensional array. Do anyone know where to find a sort routine for
2D-arrays? I want a quick method. Not Bubble sort.

Bernd P
Quicksort for multi-columns
 
Hello,

Please note that quicksort is not stable.

Maybe you would like to get mergesort or some other stable n * log(n)
algorithm...

Regards,
Bernd


All times are GMT +1. The time now is 07:03 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com