TheSwamp

Code Red => VB(A) => Topic started by: David Hall on May 05, 2006, 06:24:04 PM

Title: sort string based on particular order
Post by: David Hall on May 05, 2006, 06:24:04 PM

Sorry if this has been done, but I can t find it.

What I'm trying to do is sort a string based on a set order.  What Im doing is sorting lines "text" values for what is in an electrical trench.  the routine grabs all the lines with a crossing window, filtered on layer names, and creates a string of letters based on the layers it found.  Problem is the string is based on the order of creation.  My string letters are P (Primary duct), S (Secondary), L (lighting circuit), and X for CATV.  A typical string might look like PSSXPLPS based on the order of creation.  I am trying to sort it to look like PPPSSSLX.  Im trying to use INSTR, MID, LEFT and RIGHT to manipulate my string.

My idea is to use a while statement (or do while) to check if 'P' is INSTR, and use the returned position to feed the MID function to extract the Letter and create a new string that I will append each letter to.  Then use left and right to concatentate the string back together minus the 'P' we just removed.  Then S, L, and X.

Title: Re: sort string based on particular order
Post by: David Hall on May 05, 2006, 06:24:24 PM

Does this sound like it will work or is there a better way?

Title: Re: sort string based on particular order
Post by: JohnK on May 05, 2006, 06:28:26 PM

Humm....

Title: Re: sort string based on particular order
Post by: Jeff_M on May 05, 2006, 07:13:38 PM

Not very elegant, but does what you need...

Code: [Select]

Function testCmdrDuh(str2test As String) As String
Dim strFinal As String
Dim I As Integer

I = InStr(1, str2test, "P")

Do Until I = 0
    strFinal = strFinal & Mid(str2test, I, 1)
    str2test = Replace(str2test, "P", "", 1, 1)
    I = InStr(1, str2test, "P")
Loop

I = InStr(1, str2test, "S")

Do Until I = 0
    strFinal = strFinal & Mid(str2test, I, 1)
    str2test = Replace(str2test, "S", "", 1, 1)
    I = InStr(1, str2test, "S")
Loop

I = InStr(1, str2test, "L")

Do Until I = 0
    strFinal = strFinal & Mid(str2test, I, 1)
    str2test = Replace(str2test, "L", "", 1, 1)
    I = InStr(1, str2test, "L")
Loop

I = InStr(1, str2test, "X")

Do Until I = 0
    strFinal = strFinal & Mid(str2test, I, 1)
    str2test = Replace(str2test, "X", "", 1, 1)
    I = InStr(1, str2test, "X")
Loop

testCmdrDuh = strFinal

End Function


Title: Re: sort string based on particular order
Post by: Jeff_M on May 05, 2006, 08:22:59 PM

Better yet:

Code: [Select]

Function testCmdrDuh(str2test As String, strPattern As String) As String
Dim strFinal As String
Dim I As Integer
Dim strPat As String

Do Until strPattern = ""
    strPat = Left(strPattern, 1)
    I = InStr(1, str2test, strPat)
    Do Until I = 0
        strFinal = strFinal & Mid(str2test, I, 1)
        str2test = Replace(str2test, strPat, "", 1, 1)
        I = InStr(1, str2test, strPat)
    Loop
    strPattern = Replace(strPattern, strPat, "", 1, 1)
Loop
testCmdrDuh = strFinal

End Function

Sub test()
Debug.Print testCmdrDuh("PSSXPLPS", "PSLX")
End Sub


Title: Re: sort string based on particular order
Post by: Dnereb on May 06, 2006, 06:15:48 AM

Another way of fixing this problem.

Code: [Select]

'variation that preserves the rough data in str2test an uses 1 loop only per pattern
'thus speed things up for larger amounts of data.
Function testCmdrDuh(ByVal str2test As String, ByVal strPattern As String) As String

Dim strFinal As String
Dim PatternCounter As Long
Dim PatternCharNum As Long

Dim strPat As String

PatternCounter = 1

For PatternCounter = 1 To Len(strPattern)
    strPat = Mid$(strPattern, PatternCounter, 1)
    PatternCharNum = Len(str2test)
    str2test = Replace(str2test, strPat, "")
    strFinal = strFinal & String$(PatternCharNum - Len(str2test), strPat)
Next
testCmdrDuh = strFinal

End Function

Sub test()
Debug.Print testCmdrDuh("PSSXPLPS", "PSLX")
End Sub

Title: Re: sort string based on particular order
Post by: David Hall on May 08, 2006, 01:07:26 PM

thanks guys.  I didn't know about the replace function.  More reading to do.