按关键+后面数字升序排列(位数不一样排序1、11，2，22不能完整升序)

longwin

蒋智龙 发表于 2024-6-23 15:40
这个效果对了 不知道后面的是不是一样

前面发的代码就是这个效果，你仔细试一下

蒋智龙

longwin 发表于 2024-6-23 15:53
前面发的代码就是这个效果，你仔细试一下

我这不行我用的2021版

longwin

413254881

蒋智龙

413254881 发表于 2024-6-23 16:44

Sub t()
    arr = ThisWorkbook.Sheets("sheet1").Range("B2").Resize(Thisorkbook.Sheets("sheeti").Cells(Rows.Count, 2).End(xlUp).Row - 1, 1).Value
    Dim brr As Variant: ReDim brr(1 To UBound(arr, 1), 1 To 5)
    For i = 1 To UBound(brr, 1)
        templ = Split(arr(i, 1), "、")
        temp2 = Split(temp1(1), "+")
        For j = 1 To UBound(brr, 2)
            brr(i, 1) = temp1(0)
            temp3 = RegReplace(temp2(e), ")\d", "")
            brr(i, 2) = RegReplace(temp3, "[A-Z]+", "")
            brr(i, 3) = RegReplace(temp3, "[--龟]+", "")
            brr(i, 4) = CInt(ExtractNumbers(temp2(0)))
            brr(i, 5) = temp2(1)
        Next j
    Next i
    brr = ArraySortTwo(brr, 1, , 2, , 3, , 4, , 5)
    Dim crr As Variant: ReDim crr(1 To UBound(brr), 1 To 1) As String
    For i = 1 To UBound(brr)
        crr(i, 1) = brr(i, 1) & "、" & brr(i, 2) & brr(i, 3) & brr(i, 4) & "+ " & brr(i, 5)
    Next i
    ThisWorkbook.Sheets("sheet1").Range("c2").Resize(UBound(crr), UBound(crr, 2)) = crr
End Sub

Function ExtractNumbers(ByVal inputstring As String) As String
    Dim outputstring As String, i As Long, lenstr As Long
    lenstr = Len(inputstring)
    For i = 1 To lenstr
        If IsNumeric(Mid(inputstring, i, 1)) Then outputstring = outputstring & Mid(inputstring, i, 1)
    Next i
    ExtractNumbers = outputstring
End Function

Function RegReplace(s, pstrt, rstr) '正则替换
    Static regex As Object
    Dim temp
    If regex Is Nothing Then Set regex = CreateObject("vBScript.RegExp")
    With regex
        .Global = True
        .Pattern = pstrt
        temp = .Replace(s, rstr)
    End With
    RegReplace = temp
End Function
运行不了~~我是2021版本的office

蒋智龙

413254881 发表于 2024-6-23 16:44

可以直接发下代码吗，我敲的代码跟大哥一样 运行不了 想出来现在要 过审核，而且我用的2021版 我感觉大哥是365

413254881

哦 土木的路过

zpy2

蒋智龙 发表于 2024-6-23 14:55
这种怎么做到的

https://club.excelhome.net/blog-226915-2023.html?_dsign=bc8e55d6

在线工具 新

蒋智龙

413254881 发表于 2024-6-23 17:44
哦 土木的路过

同行啊  如果有很多字符在那里改长度

413254881

蒋智龙 发表于 2024-6-23 18:06
同行啊  如果有很多字符在那里改长度

没懂你意思  ，我这个也没有长度啊