2

How to Sort String with Numeric values using VB Script?

Below are my strings from each row from a table:

  1. "Test 1 pass dec 2"
  2. "Test 3 fail"
  3. "Test 2 pass jun 4"
  4. "Verified"
  5. "Test 10 pass"
  6. "User Accepted"

I would to like get in below order after sorting(natural order):

  1. "Test 1 pass dec 2"
  2. "Test 2 pass jun 4"
  3. "Test 3 fail"
  4. "Test 10 pass"
  5. "User Accepted"
  6. "Verified"

Ways i have tried so far,

Set oAlist=CreateObject("System.Collections.ArrayList")
oAlist.sort

The ArrayList was sorted in below order based on ASCII which I do not prefer:

  1. "Test 1 pass dec 2"
  2. "Test 10 pass"
  3. "Test 2 pass jun 4"
  4. "Test 3 fail"
  5. "User Accepted"
  6. "Verified"

I have tried this link Sort

and i have no idea how to use AppendFormat in my case.

Note:My given string either completely string or string with numbers(dynamic) so not sure how to use RecordSet or AppendFormat here as I am new to programming.

Improve this question
2
  • 1
    I'm confused about what you're really working with here. Systems.Collections.ArrayList is a .Net object... so you're using old vbscript to work VB.Net types? Commented Jun 21, 2016 at 13:54
  • Possible duplicate of Natural Sorting using VB script Commented Jun 21, 2016 at 13:59

3 Answers 3

Reset to default
0

You can have another example.

Sub Sort
    Set rs = CreateObject("ADODB.Recordset")
    If LCase(Arg(1)) = "n" then
    With rs
        .Fields.Append "SortKey", 4 
        .Fields.Append "Txt", 201, 5000 
        .Open
        Do Until Inp.AtEndOfStream
            Lne = Inp.readline
            SortKey = Mid(Lne, LCase(Arg(3)), LCase(Arg(4)) - LCase(Arg(3)))
            If IsNumeric(Sortkey) = False then
                Set RE = new Regexp
                re.Pattern = "[^0-9\.,]"
                re.global = true
                re.ignorecase = true
                Sortkey = re.replace(Sortkey, "")
            End If
            If IsNumeric(Sortkey) = False then
                Sortkey = 0
            ElseIf Sortkey = "" then
                Sortkey = 0
            ElseIf IsNull(Sortkey) = true then
                Sortkey = 0
            End If
            .AddNew
            .Fields("SortKey").value = CSng(SortKey)
            .Fields("Txt").value = Lne
            .UpDate
        Loop
        If LCase(Arg(2)) = "a" then SortColumn = "SortKey ASC"
        If LCase(Arg(2)) = "d" then SortColumn = "SortKey DESC"
        .Sort = SortColumn
        Do While not .EOF
            Outp.writeline .Fields("Txt").Value
            .MoveNext
        Loop
    End With

    ElseIf LCase(Arg(1)) = "d" then
    With rs
        .Fields.Append "SortKey", 4 
        .Fields.Append "Txt", 201, 5000 
        .Open
        Do Until Inp.AtEndOfStream
            Lne = Inp.readline
            SortKey = Mid(Lne, LCase(Arg(3)), LCase(Arg(4)) - LCase(Arg(3)))
            If IsDate(Sortkey) = False then
                Set RE = new Regexp
                re.Pattern = "[^0-9\\\-:]"
                re.global = true
                re.ignorecase = true
                Sortkey = re.replace(Sortkey, "")
            End If
            If IsDate(Sortkey) = False then
                Sortkey = 0
            ElseIf Sortkey = "" then
                Sortkey = 0
            ElseIf IsNull(Sortkey) = true then
                Sortkey = 0
            End If
            .AddNew
            .Fields("SortKey").value = CDate(SortKey)
            .Fields("Txt").value = Lne
            .UpDate
        Loop
        If LCase(Arg(2)) = "a" then SortColumn = "SortKey ASC"
        If LCase(Arg(2)) = "d" then SortColumn = "SortKey DESC"
        .Sort = SortColumn
        Do While not .EOF
            Outp.writeline .Fields("Txt").Value
            .MoveNext
        Loop
    End With


    ElseIf LCase(Arg(1)) = "t" then
    With rs
        .Fields.Append "SortKey", 201, 260 
        .Fields.Append "Txt", 201, 5000 
        .Open
        Do Until Inp.AtEndOfStream
            Lne = Inp.readline
            SortKey = Mid(Lne, LCase(Arg(3)), LCase(Arg(4)) - LCase(Arg(3)))
            .AddNew
            .Fields("SortKey").value = SortKey
            .Fields("Txt").value = Lne
            .UpDate
        Loop
        If LCase(Arg(2)) = "a" then SortColumn = "SortKey ASC"
        If LCase(Arg(2)) = "d" then SortColumn = "SortKey DESC"
        .Sort = SortColumn
        Do While not .EOF
            Outp.writeline .Fields("Txt").Value
            .MoveNext
        Loop
    End With
    ElseIf LCase(Arg(1)) = "tt" then
    With rs
        .Fields.Append "SortKey", 201, 260 
        .Fields.Append "Txt", 201, 5000 
        .Open
        Do Until Inp.AtEndOfStream
            Lne = Inp.readline
            SortKey = Trim(Mid(Lne, LCase(Arg(3)), LCase(Arg(4)) - LCase(Arg(3))))
            .AddNew
            .Fields("SortKey").value = SortKey
            .Fields("Txt").value = Lne
            .UpDate
        Loop
        If LCase(Arg(2)) = "a" then SortColumn = "SortKey ASC"
        If LCase(Arg(2)) = "d" then SortColumn = "SortKey DESC"
        .Sort = SortColumn
        Do While not .EOF
            Outp.writeline .Fields("Txt").Value
            .MoveNext
        Loop
    End With
    End If
End Sub
Improve this answer
Sign up to request clarification or add additional context in comments.

Comments

0

Since you are working with strings, you are going to need to write a custom sort function that can parse the test numbers from the strings.

Alternatively, you could pre-process your list and parse the numbers into a separate field, then sort based on that field.

Improve this answer

Comments

0

To apply the techniques from here to the problem (using Split instead of a RegExp):

Option Explicit

Dim aInp : aInp = Array( _
      "Test 1 pass dec 2" _
    , "Test 3 fail" _
    , "Test 2 pass jun 4" _
    , "Verified" _
    , "Test 10 pass" _
    , "User Accepted" _
)
WScript.Echo "----- Input:", vbCrLf & Join(aInp, vbCrLf)
Dim aOtp : aOtp = Array( _
      "Test 1 pass dec 2" _
    , "Test 2 pass jun 4" _
    , "Test 3 fail" _
    , "Test 10 pass" _
    , "User Accepted" _
    , "Verified" _
)
WScript.Echo "----- Expected:", vbCrLf & Join(aOtp, vbCrLf)

Dim oNAL : Set oNAL = CreateObject( "System.Collections.ArrayList" )
Dim oSB  : Set oSB  = CreateObject( "System.Text.StringBuilder" )
Dim sInp, aParts, aWTF
For Each sInp In aInp
    aParts = Split(sInp, " ", 3)
    Select Case UBound(aParts)
      Case 0 ' add 2 blank elms to "verified"
        aWTF = aParts
        ReDim Preserve aWTF(2)
      Case 1 ' put an empty elm in the middle
        ' aParts = Array( aParts(0), "", aParts(1))
        ' ==> VBScript runtime error: This array is fixed or temporarily locked
        aWTF = Array( aParts(0), "", aParts(1))
      Case 2 ' What the doctor ordered
        aWTF = aParts
      Case Else
        Err.Raise "Shit hits fan"
    End Select
    oSB.AppendFormat_3 "{0}{1,4}{2}", aWTF(0), aWTF(1), aWTF(2)
    sInp = oSB.ToString() & "|" & sInp ' dirty trick: append org data th ease 'reconstruction'
    oSB.Length = 0
    oNAL.Add sInp
Next
oNAL.Sort

ReDim aOut(oNAL.Count - 1)
Dim i
For i = 0 To UBound(aOut)
    aOut(i) = Split(oNAL(i), "|")(1)
Next
WScript.Echo "----- Output:", vbCrLf & Join(aOut, vbCrLf)

output:

cscript 37946075.vbs
----- Input:
Test 1 pass dec 2
Test 3 fail
Test 2 pass jun 4
Verified
Test 10 pass
User Accepted
----- Expected:
Test 1 pass dec 2
Test 2 pass jun 4
Test 3 fail
Test 10 pass
User Accepted
Verified
----- Output:
Test 1 pass dec 2
Test 2 pass jun 4
Test 3 fail
Test 10 pass
User Accepted
Verified

Just for fun: The 'same', but using a RegExp (better scaling technique):

...
Dim r    : Set r    = New RegExp
r.Pattern = "^(\w+\s*)(\d+\s*)?(.*)$"
Dim sInp, m, aParts(2)
Dim i
For Each sInp In aInp
    Set m = r.Execute(sInp)
    If 1 = m.Count Then
       For i = 0 To 2
           aParts(i) = m(0).SubMatches(i)
       Next
     Else
        Err.Raise "Shit hits fan"
    End If
    oSB.AppendFormat_3 "{0}{1,4}{2}", aParts(0), aParts(1), aParts(2)
    sInp = oSB.ToString() & "|" & sInp ' dirty trick: append org data to ease 'reconstruction'
...
Improve this answer

Comments

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.