在excel vba中，将最后一个字符视为数字，对字符串进行排序的最佳方法是什么

Question

我有一个包含字符串值的数组，我想知道对其进行排序的最佳方法，但我需要将最后一个字符视为数字。

这是一个例子： 如果我将值 IRF2BP2K10、IRF2BP2K1 和 IRF2BP2K2 作为数组中的第一个、第二个和第三个元素，我该如何对它们进行排序，以便我的数组可以排列为 {IRF2BP2K1，IRF2BP2K2，IRF2BP2K10} 而不是 {IRF2BP2K1，IRF2BP2K10，IRF2BP2K2} ?

我已经尝试了下面的基本代码，但我最终得到了第二种情况，其中 IRF2BP2K10 在 IRF2BP2K2 之前排序，因为算法只考虑字符串：

For currentitem = 1 To lastitem

    For nextitem = currentitem + 1 To lastitem

        If Array(currentitem) > Array(nextitem) Then

            Temp = Array(currentitem)
            Array(currentitem) = Array(nextitem)
            Array(nextitem) = Temp

        End If

    Next nextitem

Next currentitem

有人问我，所以这里有更多信息：并非所有项目的数字前都以“K”结尾。

以下是示例中的一些其他值，我没有将它们写成数组，因此更易于可视化：

(this list is the result using my code)
IRF2BP2KICMVCRE1
IRF2BP2KICMVCRE10
IRF2BP2KICMVCRE2
IRF2BP2KIERT2CRE1
IRF2BP2KIERT2CRE10
IRF2BP2KIERT2CRE11
IRF2BP2KIERT2CRE2
IRF2BP2KO1
IRF2BP2KO2


this is what i was trying to get:
IRF2BP2KICMVCRE1
IRF2BP2KICMVCRE2
IRF2BP2KICMVCRE10
IRF2BP2KIERT2CRE1
IRF2BP2KIERT2CRE2
IRF2BP2KIERT2CRE10
IRF2BP2KIERT2CRE11
IRF2BP2KO1
IRF2BP2KO2

我是否需要一种算法来比较数组“currentitem”的每个字符串位置与数组“nextitem”的相同位置？并且，如果它们都相等，将长度较大的项目放在长度较小的项目之后？ [这样我可以将 IRF2BP2K2 排序在 IRF2BP2K10 之前的位置，因为它们都共享相同的初始字符串“IRF2BP2K”，并且仅在最后一个字符串上有所不同（一个有“2”，另一个有“10”）]

提前致谢！

Answer 1

已编辑 GetFormattedArray() 函数“正确”格式化数组元素的最后一位

我认为您必须先正确格式化您的数组元素，然后再进行排序

例如，您可以使用以下函数返回一个格式正确的数组

Function GetFormattedArray(originalArray() As String)
    ReDim formattedArray(LBound(originalArray) To UBound(originalArray)) As String
    ReDim ipos(LBound(originalArray) To UBound(originalArray)) As Long
    Dim ielem As Long, iChar As Long, maxChar As Long
    Dim strng As String
    Const zeros As String = "0000000000"


    For ielem = LBound(originalArray) To UBound(originalArray)
        strng = originalArray(ielem)
        iChar = 1
        Do While IsNumeric(Mid(strng, Len(strng) - iChar, 1))
            iChar = iChar + 1
        Loop
        ipos(ielem) = iChar
        If iChar > maxChar Then maxChar = iChar
    Next


    For ielem = LBound(originalArray) To UBound(originalArray)
        strng = originalArray(ielem)
        formattedArray(ielem) = Left(strng, Len(strng) - ipos(ielem)) & Format(Right(strng, ipos(ielem)), Left(zeros, maxChar))
    Next

    GetFormattedArray = formattedArray
End Function

你的“主要”可以利用如下：

Sub main()
    Dim myArray(1 To 3) As String, myFormattedArray() As String
    Dim currentItem As Long, nextItem As Long, lastItem As Long
    Dim tempStrng As String

    myArray(1) = "IRF2BP2K10"
    myArray(2) = "IRF2BP2K1"
    myArray(3) = "IRF2BP2K2"

    myFormattedArray = GetFormattedArray(myArray)

    lastItem = UBound(myFormattedArray)
    For currentItem = LBound(myArray) To lastItem

        For nextItem = currentItem + 1 To lastItem

            If myFormattedArray(currentItem) > myFormattedArray(nextItem) Then

                tempStrng = myFormattedArray(currentItem)
                myFormattedArray(currentItem) = myFormattedArray(nextItem)
                myFormattedArray(nextItem) = tempStrng

            End If

        Next nextItem
    Next currentItem

End Sub

Answer 2

只需将您的冒泡排序与您自己的自定义比较器功能一起使用。我不太清楚您需要支持哪些值（此示例假设前 8 个字符作为字符串进行比较，之后的所有字符都作为数字进行比较）：

Public Function CodeGreaterThan(first As String, second As String) As Boolean
    If Left$(first, 8) > Left$(second, 8) Then
        GreaterThan = True
    ElseIf Left$(second, 8) > Left$(first, 8) Then
        GreaterThan = False
    Else
        GreaterThan = Val(Right(first, Len(first) - 8)) > _
                      Val(Right(second, Len(second) - 8))
    End If
End Function

然后用它代替>:

For currentitem = 1 To lastitem
    For nextitem = currentitem + 1 To lastitem
        If CodeGreaterThan(arr(currentitem), arr(nextitem)) Then  '<--
            temp = Array(currentitem)
            arr(currentitem) = Array(nextitem)
            arr(nextitem) = temp
        End If
    Next nextitem
Next currentitem

Answer 3

如果你右边的数据编号最多只有四位，我会尝试使用 LCase 和 UCase 来识别最后的数字，然后根据它进行排序：

Dim CurrentStg, NextStg As String

For currentitem = 1 To lastitem

For nextitem = currentitem + 1 To lastitem

If LCase(Right(Array(currentitem), 4)) = UCase(Right(Array(currentitem)), 4) Then
CurrentStg = Right(Array(currentitem), 4)
Exit For
ElseIf LCase(Right(Array(currentitem), 3)) = UCase(Right(Array(currentitem)), 3) Then
CurrentStg = Right(Array(currentitem), 3)
Exit For
ElseIf LCase(Right(Array(currentitem), 2)) = UCase(Right(Array(currentitem)), 2) Then
CurrentStg = Right(Array(currentitem), 2)
Exit For
ElseIf LCase(Right(Array(currentitem), 1)) = UCase(Right(Array(currentitem)), 1) Then
CurrentStg = Right(Array(currentitem), 1)
End If

If LCase(Right(Array(nextitem), 4)) = UCase(Right(Array(nextitem)), 4) Then
NextStg = Right(Array(nextitem), 4)
Exit For
ElseIf LCase(Right(Array(nextitem), 3)) = UCase(Right(Array(nextitem)), 3) Then
NextStg = Right(Array(nextitem), 3)
Exit For
ElseIf LCase(Right(Array(nextitem), 2)) = UCase(Right(Array(nextitem)), 2) Then
NextStg = Right(Array(nextitem), 2)
Exit For
ElseIf LCase(Right(Array(nextitem), 1)) = UCase(Right(Array(nextitem)), 1) Then
NextStg = Right(Array(nextitem), 1)
End If

    If CurrentStg > NextStg Then

        Temp = Array(currentitem)
        Array(currentitem) = Array(nextitem)
        Array(nextitem) = Temp

    End If

Next nextitem

Next currentitem

Answer 4

看看下面的例子：

Option Explicit

Sub Test()

    Dim a()
    Dim r()

    a = Array("IRF2BP2KICMVCRE1", "IRF2BP2KICMVCRE10", "IRF2BP2KICMVCRE2", "IRF2BP2KIERT2CRE1", "IRF2BP2KIERT2CRE10", "IRF2BP2KIERT2CRE11", "IRF2BP2KIERT2CRE2", "IRF2BP2KO1", "IRF2BP2KO2")
    Range("A1").Resize(UBound(a) + 1, 1).Value = WorksheetFunction.Transpose(a)
    r = SortByLastDigits(a)
    Range("B1").Resize(UBound(r) + 1, 1).Value = WorksheetFunction.Transpose(r)

End Sub

Function SortByLastDigits(Data()) As Variant()

    Const adVarChar = 200
    Const adDouble = 5

    Dim RegEx As Object
    Dim List As Object
    Dim Elem
    Dim q()
    Dim r()
    Dim n As Long

    Set RegEx = CreateObject("VBScript.RegExp")
    RegEx.Pattern = "(.*?)(\d*)$"
    Set List = CreateObject("ADOR.Recordset")
    List.Fields.Append "e", adVarChar, 255
    List.Fields.Append "t", adVarChar, 255
    List.Fields.Append "n", adDouble
    List.Open
    For Each Elem In Data
        With RegEx.Execute(Elem).Item(0)
            List.AddNew
            List("e") = Elem
            List("t") = .SubMatches(0)
            List("n") = CLng(.SubMatches(1))
            List.Update
        End With
    Next
    List.Sort = "t, n"
    List.MoveFirst
    q = List.GetRows
    ReDim r(UBound(q, 2))
    For n = 0 To UBound(q, 2)
        r(n) = q(0, n)
    Next
    SortByLastDigits = r

End Function

我的输出如下（A列中的初始数组，B列中排序）：