![]() |
sorting a one dimensional array
Hi!
I am currently and succesfully using the QuickSort algorithm for sorting 2 dimensional arrays. However, I now need something to sort a one dimensional alphanumeric array. Could some one point me to a procedure that does this? Thanks and best regards, Albert C |
sorting a one dimensional array
Function QuickSort(VA_array As Variant, _
Optional V_Low1 = -1, _ Optional V_high1 = -1) Dim V_Low2 As Long Dim V_high2 As Long Dim V_val1 As Variant Dim V_val2 As Variant 'If first time, get the size of the array to sort If V_Low1 = -1 Then V_Low1 = LBound(VA_array, 1) End If If V_high1 = -1 Then V_high1 = UBound(VA_array, 1) End If 'Set new extremes to old extremes V_Low2 = V_Low1 V_high2 = V_high1 'Get value of array item in middle of new extremes V_val1 = VA_array((V_Low1 + V_high1) / 2) 'Loop for all the items in the array between the extremes While (V_Low2 <= V_high2) 'Find the first item that is greater than the mid-point item While (VA_array(V_Low2) < V_val1 And V_Low2 < V_high1) V_Low2 = V_Low2 + 1 Wend 'Find the last item that is less than the mid-point item While (VA_array(V_high2) V_val1 And V_high2 V_Low1) V_high2 = V_high2 - 1 Wend 'If the new 'greater' item comes before the new 'less' item, swap them If (V_Low2 <= V_high2) Then V_val2 = VA_array(V_Low2) VA_array(V_Low2) = VA_array(V_high2) VA_array(V_high2) = V_val2 'Advance the pointers to the next item V_Low2 = V_Low2 + 1 V_high2 = V_high2 - 1 End If Wend 'Iterate to sort the lower half of the extremes If (V_high2 V_Low1) Then Call QuickSort(VA_array, V_Low1, V_high2) 'Iterate to sort the upper half of the extremes If (V_Low2 < V_high1) Then Call QuickSort(VA_array, V_Low2, V_high1) QuickSort = VA_array End Function If speed is important then there are faster ways to do this in VB6 RBS "Albert" wrote in message ... Hi! I am currently and succesfully using the QuickSort algorithm for sorting 2 dimensional arrays. However, I now need something to sort a one dimensional alphanumeric array. Could some one point me to a procedure that does this? Thanks and best regards, Albert C |
sorting a one dimensional array
A simple shell sort
Public Sub ShellSort(ByRef aryToSort() As Variant) Dim i As Long, j As Long Dim iLow As Long, iHigh As Long Dim tmp As Variant iLow = LBound(aryToSort) iHigh = UBound(aryToSort) j = (iHigh - iLow + 1) \ 2 Do While j 0 For i = iLow To iHigh - j If aryToSort(i) aryToSort(i + j) Then tmp = aryToSort(i) aryToSort(i) = aryToSort(i + j) aryToSort(i + j) = tmp End If Next i For i = iHigh - j To iLow Step -1 If aryToSort(i) aryToSort(i + j) Then tmp = aryToSort(i) aryToSort(i) = aryToSort(i + j) aryToSort(i + j) = tmp End If Next i j = j \ 2 Loop End Sub -- HTH Bob Phillips (replace xxxx in the email address with gmail if mailing direct) "Albert" wrote in message ... Hi! I am currently and succesfully using the QuickSort algorithm for sorting 2 dimensional arrays. However, I now need something to sort a one dimensional alphanumeric array. Could some one point me to a procedure that does this? Thanks and best regards, Albert C |
sorting a one dimensional array
Thank you sir...
Very simple and works GREAT. "Bob Phillips" wrote: A simple shell sort Public Sub ShellSort(ByRef aryToSort() As Variant) Dim i As Long, j As Long Dim iLow As Long, iHigh As Long Dim tmp As Variant iLow = LBound(aryToSort) iHigh = UBound(aryToSort) j = (iHigh - iLow + 1) \ 2 Do While j 0 For i = iLow To iHigh - j If aryToSort(i) aryToSort(i + j) Then tmp = aryToSort(i) aryToSort(i) = aryToSort(i + j) aryToSort(i + j) = tmp End If Next i For i = iHigh - j To iLow Step -1 If aryToSort(i) aryToSort(i + j) Then tmp = aryToSort(i) aryToSort(i) = aryToSort(i + j) aryToSort(i + j) = tmp End If Next i j = j \ 2 Loop End Sub -- HTH Bob Phillips (replace xxxx in the email address with gmail if mailing direct) "Albert" wrote in message ... Hi! I am currently and succesfully using the QuickSort algorithm for sorting 2 dimensional arrays. However, I now need something to sort a one dimensional alphanumeric array. Could some one point me to a procedure that does this? Thanks and best regards, Albert C |
All times are GMT +1. The time now is 06:21 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com