用VB脚本对带有数字的字符串排序

Question

如何使用VB脚本对字符串进行数字排序？

下面是表中每一行的字符串：

1. 测试1通过12月2日
2. “测试3失败”
3. “测试2通过6月4日”
4. “核实”
5. “考试10通过”
6. “用户接受”

我想在排序后按下面的顺序排列(自然顺序)：

1. 测试1通过12月2日
2. “测试2通过6月4日”
3. “测试3失败”
4. “考试10通过”
5. “用户接受”
6. “核实”

我试过的方法，

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

ArrayList是根据我不喜欢的ASCII按以下顺序排序的：

1. 测试1通过12月2日
2. “考试10通过”
3. “测试2通过6月4日”
4. “测试3失败”
5. “用户接受”
6. “核实”

我试过这个链接排序

我不知道如何在我的案例中使用AppendFormat。

备注：我的给定字符串要么完全是字符串，要么是带有数字(动态)的字符串，所以不知道如何在这里使用RecordSet或AppendFormat，因为我对编程还不熟悉。

Answer 1

你可以有另一个例子。

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

Answer 2

由于您使用的是字符串，因此需要编写一个自定义排序函数，该函数可以解析字符串中的测试编号。

或者，您可以预处理列表并将数字解析为单独的字段，然后根据该字段进行排序。

Answer 3

要应用从这里到问题的技术(使用拆分而不是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)

产出：

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

只是为了好玩：“相同”，但使用RegExp (更好的缩放技术)：

...
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'
...