对单元格中以逗号分隔的数字和文本进行排序

Question

我正在尝试对文本和数字的组合进行排序。 它适用于排序，但在单元格正确的地方，它给了我一个#VALUE！ 错误。 当它是单值示例 PR54 时，它也不会填充。 我该如何纠正？

原始单元格：A1、B13、B15

结果接收：#VALUE！

期望结果：A1、B13、B15

Function StrSort(ByVal sInp As String, _
                 Optional bDescending As Boolean = False) As String

    Dim asSS()  As String 
    Dim sSS     As String
    Dim n       As Long
    Dim i       As Long
    Dim j       As Long

    asSS = Split(sInp, ",")
    n = UBound(asSS)

 
    Dim TemporaryNumberArray() As Double

    For i = 0 To n
        If IsNumeric(Trim(asSS(i))) Then
            On Error Resume Next
            If IsError(UBound(TemporaryNumberArray)) Then
                ReDim TemporaryNumberArray(0 To 0)
            Else
                ReDim Preserve TemporaryNumberArray(0 To UBound(TemporaryNumberArray) + 1)
            End If
            On Error GoTo 0

            TemporaryNumberArray(UBound(TemporaryNumberArray)) = asSS(i)
        End If
     Next
 
    n = UBound(TemporaryNumberArray) 
    If n < 1 Then
        StrSort = sInp
    Else
        For i = 0 To n - 1
            For j = i + 1 To n
                If (TemporaryNumberArray(j) < TemporaryNumberArray(i)) Xor bDescending Then
                    sSS = TemporaryNumberArray(i)
                    TemporaryNumberArray(i) = TemporaryNumberArray(j)
                    TemporaryNumberArray(j) = sSS
                End If
            Next j
        Next i
 
        StrSort = CStr(TemporaryNumberArray(0))
        For i = 1 To n
            StrSort = StrSort & ", " & CStr(TemporaryNumberArray(i))
        Next
    End If
 
    If n < UBound(asSS) Then
        For i = 0 To UBound(asSS)
            If Not IsNumeric(asSS(i)) Then
                StrSort = StrSort & ", " & asSS(i)
            End If
        Next
    End If

End Function

先感谢您！

Answer 1

这对我有用。 您可以从工作表中调用SortList ，它会返回排序后的列表。

Function SortList(c) As String
    Dim arr, i
    
    arr = Split(c, ",")
    For i = LBound(arr) To UBound(arr) 'trim all array elements
        arr(i) = Trim(arr(i))
    Next i
    SortArray arr                'sort in-place
    SortList = Join(arr, ",")  'return sorted
End Function

'Sort an array in-place
Sub SortArray(list)
    Dim First As Long, Last As Long, i As Long, j As Long, tmp
    First = LBound(list)
    Last = UBound(list)
    For i = First To Last - 1
        For j = i + 1 To Last
            If DoCompare(Trim(list(i)), Trim(list(j))) Then 'compare the values
                tmp = list(j)             '...and in the original array
                list(j) = list(i)
                list(i) = tmp
            End If
        Next j
    Next i
End Sub

'Compare two values and return true if `a` is greater than `b`
'  (numeric values are sorted first)
Function DoCompare(a, b) As Boolean
    If IsNumeric(a) And IsNumeric(b) Then
        DoCompare = CDbl(a) > CDbl(b) 'two numbers
    ElseIf IsNumeric(a) Or IsNumeric(b) Then
        DoCompare = IsNumeric(b)      'one numeric, one alpha
    Else
        DoCompare = a > b             'two alphas
    End If
End Function