Search Tools Links Login

Text Sorting Simple and Easy


This is an easy, simple and quick code to sorte up a bunch of text lines, say you merged 2 text files and then use this code?.. it only care about the first letter of each line but its easy to add the full line if needed, look

Original Author: Spyo

Code


Revised, it was nice and simple but failed

too many text files, thanks for all inputs



Also Add a Text1 Multi line = True

and Command1 to a Form then dump all the code
below into the form, please comment some more


Option Explicit


Private Sub Command1_Click()

Dim Ray() As String, Oui As Boolean, z As Byte

Dim TmpRay As New Collection

Dim i As Integer, x As Integer, y As Integer
Dim No As Integer, Pas As Integer

z = 255

'last asc caracter also it is max up for a byte var

Oui = False

' a good name for a true false var, Oui mean Yes in french

TmpRay.Add "??"

'last possible caracter Asc255 added only for the first comparason

Text1 = "FLine 1" & vbCrLf & "XLine 2" & vbCrLf & "BLine 3" & vbCrLf & "ELine 4" & vbCrLf & "HLine 5" & vbCrLf & "ALine 6" & vbCrLf & "MLine 7" & vbCrLf & "BLine 8" & vbCrLf & "GLine 9"


Ray() = Split(Text1, vbCrLf)

For Pas = 0 To UBound(Ray)

'we splitted this amount of vdCrLt so we set it as max

For i = 0 To UBound(Ray)

'this is how many comparason per pass

x = Asc(Left(Ray(i), 1))

If x < z Then

'it may be lower lets see if its a reapeat

No = 0

Do

No = No + 1

If Ray(i) = TmpRay(No) Then

Oui = True

'while in do loop,saw it was already there

End If

Loop Until No = TmpRay.Count

' after No is equal to the collection we see if oui is still false

If Oui = False Then

z = x

'z reset at 255 then keep shrinking till nothing is lower

y = i

'y will hold the lowest possible line

End If

End If

Oui = False

'reset the oui to False default value

Next i

TmpRay.Add Ray(y)

'finally sorted, unique values are added to collection

z = 255 ' reset time

Oui = False ' reset time

Next Pas

TmpRay.Remove (1)

'deleting the asc255 value from the start

Text1 = ""

'to save lines i use this same bow to load the string now it need clearing

For i = 1 To TmpRay.Count

' max amount in the collection

Text1 = Text1 & TmpRay(i) & vbCrLf

'adding them to anything we want, textbox in this case

Next i

End Sub

About this post

Posted: 2003-06-01
By: ArchiveBot
Viewed: 91 times

Categories

Visual Basic 6

Attachments

No attachments for this post


Loading Comments ...

Comments

No comments have been added for this post.

You must be logged in to make a comment.