修复VBA自定义StrSort函数排序逗号分隔内容报#VALUE!及单值不返回问题

问题现象 #

现有自定义VBA排序函数存在两处异常：

1. 当单元格内容本身排序正确时，函数返回#VALUE!错误
2. 当单元格内为单个混合值（例如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

故障原因 #

原代码存在3个核心逻辑缺陷：

1. 未初始化数组直接调用边界函数：当输入内容不含纯数字项（如A1,B13,B15全为字母数字混合值）时，TemporaryNumberArray始终未分配内存，直接取UBound(TemporaryNumberArray)会触发运行时错误，最终返回#VALUE!
2. 排序逻辑覆盖不全：原函数仅对纯数字项做排序，所有非纯数字的混合内容会被直接追加到结果末尾，完全不参与排序，不符合混合内容排序需求
3. 缺少预处理和边界判断：拆分字符串后未去除元素前后空格，也未处理单元素输入场景，导致单值输入、带空格输入时容易触发异常

修复后代码 #

Function StrSort(ByVal sInp As String, _
                 Optional bDescending As Boolean = False) As String
    Dim asSS()  As String
    Dim n       As Long
    Dim i       As Long
    Dim j       As Long
    Dim tempVal As String
    
    ' 拆分字符串并统一去除元素前后空格
    asSS = Split(sInp, ",")
    n = UBound(asSS)
    For i = 0 To n
        asSS(i) = Trim(asSS(i))
    Next
    
    ' 单元素直接返回，兼容单个值输入场景
    If n = 0 Then
        StrSort = asSS(0)
        Exit Function
    End If
    
    ' 冒泡排序，兼容纯数字、纯文本、字母数字混合内容
    For i = 0 To n - 1
        For j = i + 1 To n
            If (StrComp(asSS(j), asSS(i), vbTextCompare) < 0) Xor bDescending Then
                tempVal = asSS(i)
                asSS(i) = asSS(j)
                asSS(j) = tempVal
            End If
        Next j
    Next i
    
    ' 拼接排序结果
    StrSort = Join(asSS, ", ")
End Function

修复说明 #

• 拆分后统一做去空格处理，避免空格导致的判断、排序异常
• 新增单元素快速返回逻辑，兼容PR54这类单个混合值输入
• 移除原有仅处理纯数字的错误逻辑，直接对所有拆分后的元素做文本自然排序，同时支持三类内容的排序需求
• 使用StrComp做不区分大小写的文本比较，排序逻辑更符合常规使用场景
• 用Join函数拼接结果，避免手动拼接导致的格式问题，已排序内容不会触发错误，直接返回符合预期的结果

内容的提问来源于stack exchange，提问作者ZulT