Question

我的数据是一个用逗号分隔的单元格中的CSI [40％]，CSSEl [50％]，LDN [10％]。谁能用excel vba代码帮助我，该代码将按百分比降序排序并向我提供以下输出：CSSEl [50％]，CSI [40％]，LDN [10％]。

Answer 1

我认为最简单的方法是创建一个用于提取数值的帮助器列。假设您的数据从A1开始，请在B列中写一个公式，例如

=MID(A1, FIND("[", A1)+1, FIND("]",A1)-FIND("[", A1)-1)

有了它，您可以轻松地对数据进行排序。

Answer 2

这将为您做到。

将以下代码添加到VBA中的新模块中，然后在与该值相邻的单元格中的单元格中调用该公式。

因此在下面的示例中，原始值位于 A 列中，而自定义UDF位于 B 列中直接相邻。

Public Function SortByInternalNumber(ByVal strText As String, ByVal strDelimiter As String)
    Dim arrValues() As String, strValue As String, i As Long, lngNumber As Long, arrNumbers() As String
    Dim strNumber As String, lngMaxNumber As Long, lngMaxIndex As Long, strResult As String
    Dim bFound As Boolean, arrMaxValues() As Long, lngIndex As Long, strMaxValue As String
    Dim strThisValue As String

    Application.Volatile

    ' Split up the initial string with all of the values.
    arrValues = Split(strText, strDelimiter)

    For i = 0 To UBound(arrValues)
        strValue = Trim(arrValues(i))

        strNumber = Replace(Replace(Split(strValue, "[")(1), "%", ""), "]", "")

        ReDim Preserve arrNumbers(i)
        arrNumbers(i) = strNumber
    Next

    ' Now process all of the numbers in the descending order.
    Do While 1 = 1
        lngMaxNumber = -1
        bFound = False

        For i = 0 To UBound(arrNumbers)
            If arrNumbers(i) <> "" Then
                lngNumber = CLng(arrNumbers(i))

                If lngMaxNumber < lngNumber Then
                    lngMaxNumber = lngNumber
                    lngMaxIndex = i
                End If

                bFound = True
            End If
        Next

        If Not bFound Then Exit Do
        lngIndex = -1

        ' Retrieve all of the values that are of the same value as the current max.
        For i = 0 To UBound(arrNumbers)
            If arrNumbers(i) <> "" Then
                If CLng(arrNumbers(i)) = lngMaxNumber Then
                    lngIndex = lngIndex + 1
                    ReDim Preserve arrMaxValues(lngIndex)
                    arrMaxValues(lngIndex) = i
                End If
            End If
        Next

        strMaxValue = ""

        ' Now do the same thing as above but instead of descending, do ascending.
        For i = 0 To UBound(arrMaxValues)
            strThisValue = Trim(arrValues(arrMaxValues(i)))

            If strMaxValue > strThisValue Or strMaxValue = "" Then
                strMaxValue = strThisValue
                lngMaxIndex = arrMaxValues(i)
            End If
        Next

        strResult = strResult & ", " & strMaxValue 
        arrNumbers(lngMaxIndex) = ""
    Loop

    If strResult <> "" Then
        strResult = Mid(strResult, 3)
    End If

    SortByInternalNumber = Trim(strResult)
End Function

它相当严格，但是我已经证明您可以参数化更多相关选项。

我希望这是有道理的，希望这就是你的追求。

Answer 3

可以尝试其他替代方法

Sub testsort()
Dim txt As String, txt2 As String, Arr As Variant
Dim Nums() As Long, NumSort() As Long, i As Integer, k As Integer


txt = "CSI [40%], CSSEl [50%], LDN [10%], ABC [40%],ZXH[30%]"
Arr = Split(txt, ",")
ReDim Nums(LBound(Arr) To UBound(Arr))
ReDim NumSort(LBound(Arr) To UBound(Arr))
    For i = LBound(Arr) To UBound(Arr)
    Spos = InStr(1, Arr(i), "[")
    Epos = InStr(1, Arr(i), "%")
       If Spos > 0 And Epos > Spos Then
       Nums(i) = Val(Mid(Arr(i), Spos + 1, Epos - Spos - 1))
       Else
       Nums(i) = 0
       End If
    Next i


    For i = LBound(Arr) To UBound(Arr)
    NumSort(i) = LBound(Arr)
        For k = LBound(Arr) To UBound(Arr)
            If Nums(i) < Nums(k) Or (Nums(i) = Nums(k) And k < i) Then
            NumSort(i) = NumSort(i) + 1
            End If
        Next
    Debug.Print Arr(i), Nums(i), NumSort(i)
    Next


    For i = LBound(Arr) To UBound(Arr)  ' rank
    For k = LBound(Arr) To UBound(Arr)
    If NumSort(k) = i Then
    txt2 = txt2 & Arr(k) & ","
    Exit For
    End If
    Next k
    Next i

    If Len(txt2) > 0 Then txt2 = Left(txt2, Len(txt2) - 1) 'delete last comma
    Debug.Print txt2
End Sub

如何按降序对附加在单元格中文本的数字进行排序

3 个答案: