Printable View
Hi guys I am New to excel programming i am to make a small program in excel for which i want to know.is there a quick way to get an array that holds 30 names alphabetically sorted? . any help would be great. my array is called str(30) thanks in advance.
maybe this will be of any help to you.Quote:
Originally Posted by Kelsey
Sub sort_array()
Dim arr As Variant
Dim i As Long, j As Long, temp As Long
'sort the array
arr = Array(2, 3, 4, 1, 6, 8, 7)
For i = LBound(arr) To UBound(arr) - 1
For j = i + 1 To UBound(arr)
If arr(i) > arr(j) Then
temp = arr(j)
arr(j) = arr(i)
arr(i) = temp
End If
Next j
Next i
End Sub
Str is a reserved word so this uses MyString and uses column A to sort the arrayQuote:
Originally Posted by Kelsey
Sub SortArray()
MyStr = Array("x", "r", "p", "q", "a", "v", "j", "t", "g", "c")
For x = 0 To 9
p = x + 1
Cells(p, "A").Value = MyStr(x)
Next
Columns("A:A").Sort Key1:=Range("A1")
For x = 0 To 9
p = x + 1
MyStr(x) = Cells(p, "A").Value
Next
End Sub
this should help you
If you are dealing with large arrays then use a QuickSort as it will beQuote:
Originally Posted by Kelsey
faster:
Function QuickSortStringAsc(arrString() As String, _
Optional lLow1 = -1, _
Optional lhigh1 = -1)
Dim lLow2 As Long
Dim lhigh2 As Long
Dim strVal1 As String
Dim strVal2 As String
'If first time, get the size of the array to sort
If lLow1 = -1 Then
lLow1 = LBound(arrString, 1)
End If
If lhigh1 = -1 Then
lhigh1 = UBound(arrString, 1)
End If
'Set new extremes to old extremes
lLow2 = lLow1
lhigh2 = lhigh1
'Get value of array item in middle of new extremes
strVal1 = arrString((lLow1 + lhigh1) / 2)
'Loop for all the items in the array between the extremes
While (lLow2 <= lhigh2)
'Find the first item that is greater than the mid-point item
While (arrString(lLow2) < strVal1 And lLow2 < lhigh1)
lLow2 = lLow2 + 1
Wend
'Find the last item that is less than the mid-point item
While (arrString(lhigh2) > strVal1 And lhigh2 > lLow1)
lhigh2 = lhigh2 - 1
Wend
'If the new 'greater' item comes before the new 'less' item, swap them
If (lLow2 <= lhigh2) Then
strVal2 = arrString(lLow2)
arrString(lLow2) = arrString(lhigh2)
arrString(lhigh2) = strVal2
'Advance the pointers to the next item
lLow2 = lLow2 + 1
lhigh2 = lhigh2 - 1
End If
Wend
'Iterate to sort the lower half of the extremes
If (lhigh2 > lLow1) Then
QuickSortStringAsc arrString, lLow1, lhigh2
End If
'Iterate to sort the upper half of the extremes
If (lLow2 < lhigh1) Then
QuickSortStringAsc arrString, lLow2, lhigh1
End If
QuickSortStringAsc = arrString
End Function
Function QuickSortStringDesc(arrString() As String, _
Optional lLow1 = -1, _
Optional lhigh1 = -1)
Dim lLow2 As Long
Dim lhigh2 As Long
Dim strVal1 As String
Dim strVal2 As String
'If first time, get the size of the array to sort
If lLow1 = -1 Then
lLow1 = LBound(arrString, 1)
End If
If lhigh1 = -1 Then
lhigh1 = UBound(arrString, 1)
End If
'Set new extremes to old extremes
lLow2 = lLow1
lhigh2 = lhigh1
'Get value of array item in middle of new extremes
strVal1 = arrString((lLow1 + lhigh1) / 2)
'Loop for all the items in the array between the extremes
While (lLow2 <= lhigh2)
'Find the first item that is greater than the mid-point item
While (arrString(lLow2) > strVal1 And lLow2 < lhigh1)
lLow2 = lLow2 + 1
Wend
'Find the last item that is less than the mid-point item
While (arrString(lhigh2) < strVal1 And lhigh2 > lLow1)
lhigh2 = lhigh2 - 1
Wend
'If the new 'greater' item comes before the new 'less' item, swap them
If (lLow2 <= lhigh2) Then
strVal2 = arrString(lLow2)
arrString(lLow2) = arrString(lhigh2)
arrString(lhigh2) = strVal2
'Advance the pointers to the next item
lLow2 = lLow2 + 1
lhigh2 = lhigh2 - 1
End If
Wend
'Iterate to sort the lower half of the extremes
If (lhigh2 > lLow1) Then
QuickSortStringDesc arrString, lLow1, lhigh2
End If
'Iterate to sort the upper half of the extremes
If (lLow2 < lhigh1) Then
QuickSortStringDesc arrString, lLow2, lhigh1
End If
QuickSortStringDesc = arrString
End Function
Sub test()
Dim i As Long
Dim arr() As String
Dim bSortDesc As Boolean
'bSortDesc = True
ReDim arr(30) As String
'to get random integer within range:
'Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
'-----------------------------------------------------
For i = 0 To 30
'random characters between A and Z
arr(i) = Chr(Int(26 * Rnd + 65))
Next i
If bSortDesc Then
arr = QuickSortStringDesc(arr)
Else
arr = QuickSortStringAsc(arr)
End If
For i = 0 To 30
Cells(i + 1, 1) = arr(i)
Next i
End Sub