在excel vba中，将最后一个字符视为数字，对string进行sorting的最佳方式是什么？
我有一个具有string值的数组，我想知道sorting它的最佳方法，但我需要考虑最后的字符作为数字。
这里是一个例子：如果我的数组中有第一，第二和第三个元素的值为IRF2BP2K10，IRF2BP2K1和IRF2BP2K2，如何对它们进行sorting，这样我的数组可以排列为{IRF2BP2K1，IRF2BP2K2，IRF2BP2K10}而不是{IRF2BP2K1 ，IRF2BP2K10，IRF2BP2K2}？
我已经尝试了下面的基本代码，但是最后是第二种情况，IRF2BP2K10在IRF2BP2K2之前sorting，因为algorithm只考虑string：
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
我是否需要一个algorithm来比较数组的“currentitem”的每个string位置与数组的“nextitem”的相同位置？ 而且，如果它们全部相等，则将长度较长的项目放在长度较小的项目之后？ [这样我可以在IRF2BP2K10之前的位置对IRF2BP2K2进行sorting，因为它们都共享相同的初始string“IRF2BP2K”，并且仅在最后一个string（一个具有“2”而另一个具有“10”）时不同）
提前致谢！
编辑 GetFormattedArray()函数来“正确地”格式化数组元素的最后一个数字
我想你必须先格式化你的数组元素，然后进行sorting
例如你可以使用下面的函数返回一个格式正确的数组
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
只需使用您的自定义比较器function您的bubblesort。 我并不清楚你需要支持哪些值（这个例子假设前8个字符被比较为string，之后的所有内容都被作为一个数字进行比较）：
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
如果您右侧的数据编号只包含最多四位数字，我会尝试使用LCase和UCase来识别最后的数字，然后根据以下内容进行sorting：
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
看看下面的例子：
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初始数组，在列Bsorting）：
