Excel VBA中OutlierString调用IdentifyOutliers时出现#Value!错误求助

我有两个Excel VBA函数：IdentifyOutliers和OutlierString。OutlierString调用IdentifyOutliers，后者用于在工作簿的命名区域Data_Table_1（仅包含A2:D7，不含首行标签）中查找异常值。OutlierString本应返回形如*"The outliers are 45, 65."*的语句，但在单元格输入=OutlierString(Data_Table_1)并计算工作表时，出现#Value!错误。

已确认单独使用IdentifyOutliers可正常返回异常值，但会溢出到相邻单元格，不符合需求。当前工作表设置为手动计算。

原函数代码 #

IdentifyOutliers函数 #

Function IdentifyOutliers(rng As Range) As Variant
Dim mean As Double
Dim Q1 As Double
Dim Q2 As Double
Dim Q3 As Double
Dim IQR As Double
Dim n As Long
Dim i As Long
Dim cell As Range
Dim z As Double
Dim outliers() As Variant
Dim outlierCount As Long

n = rng.count
Q1 = Application.WorksheetFunction.Quartile_Inc(rng, 1)
Q2 = Application.WorksheetFunction.Quartile_Inc(rng, 2)
Q3 = Application.WorksheetFunction.Quartile_Inc(rng, 3)
IQR = Q3 - Q1

outlierCount = 0
ReDim outliers(1 To n)

For Each cell In rng
    
    If cell.Value > Q3 + 1.5 * IQR Or cell.Value < Q1 - 1.5 * IQR Then
        outlierCount = outlierCount + 1
        outliers(outlierCount) = cell.Value
    End If
Next cell

If outlierCount = 0 Then
    IdentifyOutliers = "No outliers found."
Else
    ReDim Preserve outliers(1 To outlierCount)
    IdentifyOutliers = outliers
End If
End Function

OutlierString函数 #

Function OutlierString(dataRange As Range) As String
Dim outliers() As Variant
Dim i As Long
Dim result As String
Dim count As Long


outliers = IdentifyOutliers(dataRange) 

count = UBound(outliers) - LBound(outliers) + 1
If count > 0 Then
    result = "The outliers are "
    For i = LBound(outliers) To UBound(outliers)
        result = result & outliers(i)
        If i < UBound(outliers) Then
            result = result & ", "
        End If
    Next i
Else
    result = "No outliers found."
End If

OutlierString = result
End Function

错误原因 #

1. 返回类型不匹配：IdentifyOutliers在无异常值时返回字符串*"No outliers found."*，有异常值时返回数组。但OutlierString中直接将返回值赋值给数组变量outliers()，当返回字符串时会触发类型不匹配错误，导致#Value!。
2. 输出格式不完善：原OutlierString的循环逻辑没有在最后一个异常值后添加句号，不符合预期的语句格式。

修正方案 #

调整IdentifyOutliers函数 #

统一返回类型为数组，无异常值时返回空数组，彻底避免类型冲突：

Function IdentifyOutliers(rng As Range) As Variant
    Dim Q1 As Double, Q3 As Double, IQR As Double
    Dim outlierCount As Long
    Dim outliers() As Variant
    Dim cell As Range
    
    ' 处理空区域的边界情况
    If rng.Cells.Count = 0 Then
        IdentifyOutliers = Array()
        Exit Function
    End If
    
    Q1 = Application.WorksheetFunction.Quartile_Inc(rng, 1)
    Q3 = Application.WorksheetFunction.Quartile_Inc(rng, 3)
    IQR = Q3 - Q1
    
    outlierCount = 0
    ReDim outliers(1 To rng.Cells.Count)
    
    For Each cell In rng
        ' 跳过空单元格和非数值内容
        If Not IsEmpty(cell.Value) And IsNumeric(cell.Value) Then
            If cell.Value > Q3 + 1.5 * IQR Or cell.Value < Q1 - 1.5 * IQR Then
                outlierCount = outlierCount + 1
                outliers(outlierCount) = cell.Value
            End If
        End If
    Next cell
    
    If outlierCount = 0 Then
        IdentifyOutliers = Array() ' 返回空数组而非字符串
    Else
        ReDim Preserve outliers(1 To outlierCount)
        IdentifyOutliers = outliers
    End If
End Function

修正OutlierString函数 #

增加数组类型判断，处理空数组情况，并完善输出格式：

Function OutlierString(dataRange As Range) As String
    Dim outliers As Variant
    Dim i As Long
    Dim result As String
    
    outliers = IdentifyOutliers(dataRange)
    
    ' 判断返回值是否为有效数组
    If IsArray(outliers) And UBound(outliers) >= LBound(outliers) Then
        result = "The outliers are "
        For i = LBound(outliers) To UBound(outliers)
            result = result & outliers(i)
            If i < UBound(outliers) Then
                result = result & ", "
            Else
                result = result & "." ' 最后一个元素后添加句号
            End If
        Next i
    Else
        result = "No outliers found."
    End If
    
    OutlierString = result
End Function

额外优化说明 #

• 增加了对空单元格和非数值单元格的过滤，避免无效内容干扰异常值计算。
• 统一返回类型为数组，彻底解决跨函数调用的类型不匹配问题。
• 完善输出语句格式，确保符合预期的标点规范。

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