Tek-Tips is the largest IT community on the Internet today!
Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!
-
Congratulations TouchToneTommy on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!
Sorting either a text file or Access Table... 1
- Thread starter VisualGuy
- Start date
You could use the following:
Purpose: This function will sort the contents of an array in ascendning order. By changing the direction of the "<" you can change the sort order to descending.
The function does require an Array of the string type. I will generally put the information that the data is to be sorted in at the beginning of the string then rearrange if needed. Hope this works for you.
Public Sub Bubble_Sort(ByRef SortArray() As String)
Dim Temp As String
Dim I As Integer, J As Integer
For I = 0 To UBound(SortArray)
For J = 0 To UBound(SortArray)
If SortArray(I) < SortArray(J) Then
Temp = SortArray(I)
SortArray(I) = SortArray(J)
SortArray(J) = Temp
End If
Next J
Next I
End Sub
Purpose: This function will sort the contents of an array in ascendning order. By changing the direction of the "<" you can change the sort order to descending.
The function does require an Array of the string type. I will generally put the information that the data is to be sorted in at the beginning of the string then rearrange if needed. Hope this works for you.
Public Sub Bubble_Sort(ByRef SortArray() As String)
Dim Temp As String
Dim I As Integer, J As Integer
For I = 0 To UBound(SortArray)
For J = 0 To UBound(SortArray)
If SortArray(I) < SortArray(J) Then
Temp = SortArray(I)
SortArray(I) = SortArray(J)
SortArray(J) = Temp
End If
Next J
Next I
End Sub
-
1
- #3
JohnYingling
Programmer
Make it twice as fast. After each I, SortArray(I) will contain the least item of all items from I through Ubound(SortArray). There is no need for J to ever be < I + 1.
For I = 0 To UBound(SortArray) - 1
For J = I + 1 To UBound(SortArray)
Forms/Controls Resizing/Tabbing Control
Compare Code (Text)
Generate Sort Class in VB or VBScript
For I = 0 To UBound(SortArray) - 1
For J = I + 1 To UBound(SortArray)
Forms/Controls Resizing/Tabbing Control
Compare Code (Text)
Generate Sort Class in VB or VBScript
And... to get the textfile into an array...
Dim FileName As String, FileText() as String
...
FilenName = "Textfile.txt" 'Set the name of the file
...
Open FileName for Input As #1
FileText = Split(Input(LOF(1),#1), vbCrLf)
Close
FileText now contains an array of the files contents...
Each array element is a line from the File...
Have Fun, Be Young... Code BASIC
-Josh Stribling
Dim FileName As String, FileText() as String
...
FilenName = "Textfile.txt" 'Set the name of the file
...
Open FileName for Input As #1
FileText = Split(Input(LOF(1),#1), vbCrLf)
Close
FileText now contains an array of the files contents...
Each array element is a line from the File...
Have Fun, Be Young... Code BASIC
-Josh Stribling
You want speed!?!?!?!?!?
The first set of times and average are the origional by bakerm
The second set of times are with the same code but with JohnYingling modification (see above)
The third set are with another modification by me (see below)
[tt]
Times = 166061761,160231141,160078293,159680381,159879365,159959931,160191433,160024302,174919423,159223220
Average = 162024925
Times = 84748409,94847657,84806582,89830338,95663209,100300661,99887388,92226552,84315037,84194352
Average = 91082018.5
Times = 81564598,78090568,77864194,79377720,77766780,78189523,78694670,77761008,77892423,77768372
Average = 78496985.6
[/tt]
The modifications are as follows...
I used JohnYingling's modification along with...
Change the loop integers to long and remove from the loop the ubound checks
[tt]
Public Sub Bubble_Sort_VB5(ByRef SortArray() As String)
Dim Temp As String
Dim I As Long, J As Long
Dim U As Long
U = UBound(SortArray)
For I = 0 To U
For J = I + 1 To U
If SortArray(I) < SortArray(J) Then
Temp = SortArray(I)
SortArray(I) = SortArray(J)
SortArray(J) = Temp
End If
Next J
Next I
End Sub
[/tt]
How the test was run...
[tt]
Option Explicit
Private Type LARGE_INTEGER
lowpart As Long
highpart As Long
End Type
Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As LARGE_INTEGER) As Long
Private Sub Command1_Click()
Dim StartTime As LARGE_INTEGER, StopTime As LARGE_INTEGER
Dim Df1(1 To 10) As Variant
Dim SortArray(10000) As String, I As Long
Dim ReturnValue As Long, MyDec As Variant
MyDec = CDec(4294967296#)
For I = 1 To 10
InitializeArray SortArray
ReturnValue = QueryPerformanceCounter(StartTime)
Bubble_Sort SortArray
ReturnValue = QueryPerformanceCounter(StopTime)
Df1(I) = CDec(((MyDec * StopTime.highpart) + StopTime.lowpart) - ((MyDec * StartTime.highpart) + StartTime.lowpart))
Next I
Debug.Print "Times = " & Df1(1) & "," & Df1(2) & "," & Df1(3) & "," & Df1(4) & "," & Df1(5) & "," & Df1(6) & "," & Df1(7) & "," & Df1(8) & "," & Df1(9) & "," & Df1(10)
Debug.Print "Average = " & ((Df1(1) + Df1(2) + Df1(3) + Df1(4) + Df1(5) + Df1(6) + Df1(7) + Df1(8) + Df1(9) + Df1(10)) / 10)
For I = 1 To 10
InitializeArray SortArray
ReturnValue = QueryPerformanceCounter(StartTime)
Bubble_Sort_John SortArray
ReturnValue = QueryPerformanceCounter(StopTime)
Df1(I) = CDec(((MyDec * StopTime.highpart) + StopTime.lowpart) - ((MyDec * StartTime.highpart) + StartTime.lowpart))
Next I
Debug.Print "Times = " & Df1(1) & "," & Df1(2) & "," & Df1(3) & "," & Df1(4) & "," & Df1(5) & "," & Df1(6) & "," & Df1(7) & "," & Df1(8) & "," & Df1(9) & "," & Df1(10)
Debug.Print "Average = " & ((Df1(1) + Df1(2) + Df1(3) + Df1(4) + Df1(5) + Df1(6) + Df1(7) + Df1(8) + Df1(9) + Df1(10)) / 10)
For I = 1 To 10
InitializeArray SortArray
ReturnValue = QueryPerformanceCounter(StartTime)
Bubble_Sort_VB5 SortArray
ReturnValue = QueryPerformanceCounter(StopTime)
Df1(I) = CDec(((MyDec * StopTime.highpart) + StopTime.lowpart) - ((MyDec * StartTime.highpart) + StartTime.lowpart))
Next I
Debug.Print "Times = " & Df1(1) & "," & Df1(2) & "," & Df1(3) & "," & Df1(4) & "," & Df1(5) & "," & Df1(6) & "," & Df1(7) & "," & Df1(8) & "," & Df1(9) & "," & Df1(10)
Debug.Print "Average = " & ((Df1(1) + Df1(2) + Df1(3) + Df1(4) + Df1(5) + Df1(6) + Df1(7) + Df1(8) + Df1(9) + Df1(10)) / 10)
End Sub
Private Sub InitializeArray(ByRef SortArray() As String)
Randomize
Dim I As Long
For I = 0 To 10000
SortArray(I) = Trim(Str(Int((1000 * Rnd(I)) + 1)))
Next I
End Sub
Public Sub Bubble_Sort(ByRef SortArray() As String)
Dim Temp As String
Dim I As Integer, J As Integer
For I = 0 To UBound(SortArray)
For J = 0 To UBound(SortArray)
If SortArray(I) < SortArray(J) Then
Temp = SortArray(I)
SortArray(I) = SortArray(J)
SortArray(J) = Temp
End If
Next J
Next I
End Sub
Public Sub Bubble_Sort_John(ByRef SortArray() As String)
Dim Temp As String
Dim I As Integer, J As Integer
For I = 0 To UBound(SortArray)
For J = I + 1 To UBound(SortArray)
If SortArray(I) < SortArray(J) Then
Temp = SortArray(I)
SortArray(I) = SortArray(J)
SortArray(J) = Temp
End If
Next J
Next I
End Sub
Public Sub Bubble_Sort_VB5(ByRef SortArray() As String)
Dim Temp As String
Dim I As Long, J As Long
Dim U As Long
U = UBound(SortArray)
For I = 0 To U
For J = I + 1 To U
If SortArray(I) < SortArray(J) Then
Temp = SortArray(I)
SortArray(I) = SortArray(J)
SortArray(J) = Temp
End If
Next J
Next I
End Sub
[/tt]
Have Fun And Good Luck
JohnYingling
Programmer
I think that you will find that
U = UBound(SortArray)
is superfluous because the End argument is evaluated once and put into a temporary variable. If you chnage the End inside the loop, it will have no effect. The following code displays 10.
Dim I As Long
Dim J As Long
Dim K As Long
J = 9
For I = 0 To J
K = K + 1
J = 0
Next
MsgBox CStr(K) ' Displays 10
Forms/Controls Resizing/Tabbing Control
Compare Code (Text)
Generate Sort Class in VB or VBScript
U = UBound(SortArray)
is superfluous because the End argument is evaluated once and put into a temporary variable. If you chnage the End inside the loop, it will have no effect. The following code displays 10.
Dim I As Long
Dim J As Long
Dim K As Long
J = 9
For I = 0 To J
K = K + 1
J = 0
Next
MsgBox CStr(K) ' Displays 10
Forms/Controls Resizing/Tabbing Control
Compare Code (Text)
Generate Sort Class in VB or VBScript
Wow...
No one has mentioned QuickSort yet...
You can use the infamous FAST recursive routine, known as QuickSort, and gain incredible speed...
Use a recursive Routine to Sort throught the array... As the variables are returned from the function, the array will be sorted... And Cut your Loop time into a fraction...
do a google search on quicksort... you can find more than enough examples, and explainations...
*note: a recursive function is one that conditionally calls itself...
such as
Fuction AddTo(X as integer)
If X > 0 Then AddTo = X + AddTo(X - 1)
End Function
AddTo(1) will = 1 ... (1 + 0)
AddTo(2) will = 3 ... (2 + 1 + 0)
AddTo(3) will = 6 ... (3 + 2 + 1 + 0)
...
If you do not make it conditional, such as this:
*Warning: DO NOT TRY THIS...
Fuction AddTo(X as integer)
AddTo = X + AddTo(X - 1)
End Function
You will create an endless loop and run out of stack space...
AddTo(3) will = 3 + 2 + 1 + 0 + -1 + -2 + -3 + -4 + -5 ...
So make sure you place the recursive part inside a conditional statement...
This Is similar to the instance when 2 or more subs/functions call each other...
Function NIKE()
NIKE = JustDoIt
End Function
Function JustDoIt()
JustDoIt = NIKE
End Function
Which will also create an endless loop (and a serious lack of stack space)
Both of these senarios are dangerous and need to be watched out for... or can cause some major pains when trying to debug...
Have Fun, Be Young... Code BASIC
-Josh Stribling
No one has mentioned QuickSort yet...
You can use the infamous FAST recursive routine, known as QuickSort, and gain incredible speed...
Use a recursive Routine to Sort throught the array... As the variables are returned from the function, the array will be sorted... And Cut your Loop time into a fraction...
do a google search on quicksort... you can find more than enough examples, and explainations...
*note: a recursive function is one that conditionally calls itself...
such as
Fuction AddTo(X as integer)
If X > 0 Then AddTo = X + AddTo(X - 1)
End Function
AddTo(1) will = 1 ... (1 + 0)
AddTo(2) will = 3 ... (2 + 1 + 0)
AddTo(3) will = 6 ... (3 + 2 + 1 + 0)
...
If you do not make it conditional, such as this:
*Warning: DO NOT TRY THIS...
Fuction AddTo(X as integer)
AddTo = X + AddTo(X - 1)
End Function
You will create an endless loop and run out of stack space...
AddTo(3) will = 3 + 2 + 1 + 0 + -1 + -2 + -3 + -4 + -5 ...
So make sure you place the recursive part inside a conditional statement...
This Is similar to the instance when 2 or more subs/functions call each other...
Function NIKE()
NIKE = JustDoIt
End Function
Function JustDoIt()
JustDoIt = NIKE
End Function
Which will also create an endless loop (and a serious lack of stack space)
Both of these senarios are dangerous and need to be watched out for... or can cause some major pains when trying to debug...
Have Fun, Be Young... Code BASIC
-Josh Stribling
JohnYingling,
[tt]
I think that you will find that
U = UBound(SortArray)
is superfluous because the End argument is evaluated once and put into a temporary variable.
[/tt]
This is true but where the savings in cycles comes in, is that my algorithm only does the evaluation once (UBound(array) takes more cycles than variable = value), and in this instance with an inner loop based upon the same max amount it gives you a savings in cycles (see test above). Now if it was only a single loop then I would agree that it is superfluous.
See what this does for the record (Sorts Ascending):
Public Sub ShellSort()
'from msdn
Dim TempVal As Variant
Dim I As Long, GapSize As Long, CurPos As Long
Dim FirstRow As Long, LastRow As Long, NumRows As Long
FirstRow = LBound(SortArray)
LastRow = UBound(SortArray)
NumRows = LastRow - FirstRow + 1
Do
GapSize = GapSize * 3 + 1
Loop Until GapSize > NumRows
Do
GapSize = GapSize \ 3
For I = (GapSize + FirstRow) To LastRow
CurPos = I
TempVal = SortArray(I)
Do While (SortArray(CurPos - GapSize) > TempVal)
SortArray(CurPos) = SortArray(CurPos - GapSize)
CurPos = CurPos - GapSize
If (CurPos - GapSize) < FirstRow Then Exit Do
Loop
SortArray(CurPos) = TempVal
Next
Loop Until GapSize = 1
End Sub
I also posted a Number sort under:
thread222-504185 thread222-500319
Public Sub ShellSort()
'from msdn
Dim TempVal As Variant
Dim I As Long, GapSize As Long, CurPos As Long
Dim FirstRow As Long, LastRow As Long, NumRows As Long
FirstRow = LBound(SortArray)
LastRow = UBound(SortArray)
NumRows = LastRow - FirstRow + 1
Do
GapSize = GapSize * 3 + 1
Loop Until GapSize > NumRows
Do
GapSize = GapSize \ 3
For I = (GapSize + FirstRow) To LastRow
CurPos = I
TempVal = SortArray(I)
Do While (SortArray(CurPos - GapSize) > TempVal)
SortArray(CurPos) = SortArray(CurPos - GapSize)
CurPos = CurPos - GapSize
If (CurPos - GapSize) < FirstRow Then Exit Do
Loop
SortArray(CurPos) = TempVal
Next
Loop Until GapSize = 1
End Sub
I also posted a Number sort under:
thread222-504185 thread222-500319
JohnYingling
Programmer
VB5PRGMR.
You are absolutely right about the inner loop. I missed that.
Forms/Controls Resizing/Tabbing Control
Compare Code (Text)
Generate Sort Class in VB or VBScript
You are absolutely right about the inner loop. I missed that.
Forms/Controls Resizing/Tabbing Control
Compare Code (Text)
Generate Sort Class in VB or VBScript
CCLINT, whooooa!! had to do it twice just to make sure
[tt]
Times = 850491,928750,863697,864736,870744,881319,897215,870879,874587,880341
Average = 878275.9
Times = 863701,885160,959814,912532,875984,904884,859664,874534,875967,877470
Average = 888971
[/tt]
by far the fastest.
- Status
