VBA自定义函数AbsorbentClass循环与#VALUE!错误调试求助

我编写了VBA自定义函数AbsorbentClass，目标是将组成sumref的f-j值以0.05为步长调整，使sumref与api的偏差处于0.1范围内。最初的Do-While循环逻辑不符合需求，修改逻辑后函数出现#VALUE!错误，尝试将数组拆分为单个变量后问题仍存在，恳请帮忙调试解决。

各阶段代码 #

第一版代码 #

Function AbsorbentClass(a, b, c, d, e, Optional crit As Variant = "TRUE") As Variant

f = 0.8
g = 1
h = 1
i = 1
j = 0.9

api = Application.MRound(((a + b + c + d + e) / 5), 0.05)
sumref = Application.MRound(((f + g + h + i + j) / 5), 0.05)

If api < sumref Then
    Do While Application.RoundUp(api, 1) = Application.RoundDown(sumref, 1)
        f = f + 0.05
        g = g + 0.05
        h = h + 0.05
        i = i + 0.05
        j = j + 0.05
    Loop
End If
If api > sumref Then
    Do While Application.RoundDown(api, 1) = Application.RoundUp(sumref, 1)
        f = f - 0.05
        g = g - 0.05
        h = h - 0.05
        i = i - 0.05
        j = j - 0.05
    Loop
End If

aw = g

If crit = "TRUE" Then

    ans = aw

Else

    If g < 0.15 Then
        ans = "Not classified"

    ElseIf g > 0.15 And g < 0.3 Then
        ans = "E"

    ElseIf g > 0.3 And g < 0.6 Then
        ans = "D"

    ElseIf g >= 0.6 And g < 0.8 Then
        ans = "C"

    ElseIf g >= 0.8 And g < 0.9 Then
        ans = "B"
    
    ElseIf g >= 0.9 Then
        ans = "A"
    
    End If
End If
    AbsorbentClass = ans

End Function

修改后出现#VALUE!错误的代码 #

Function AbsorbentClass(a, b, c, d, e, Optional crit As Variant = "TRUE") As Variant

f = 0.8
g = 1
h = 1
i = 1
j = 0.9

api = Application.MRound(((a + b + c + d + e) / 5), 0.05) 'check to 
compare whether average of api or sumref is higher
sumref = Application.MRound(((f + g + h + i + j) / 5), 0.05)

Udeviation = Array(f - a, g - b, h - c, i - d, j - e) 'setting the range for the ifsum below

If api < sumref Then
    Do While Application.sumif((Udeviation), ">0") >= 0.1 'whilst sum of positive unfavorable deviations are greater than 0.1, proceed to add 0.05 to each term (f-j)
        f = f + 0.05
        g = g + 0.05
        h = h + 0.05
        i = i + 0.05
        j = j + 0.05
        Udeviation = Array(f - a, g - b, h - c, i - d, j - e) 'recalculate unfavorable deviations
    Loop
End If

'removed rest of code for now

    AbsorbentClass = g

End Function

拆分数组后的代码 #

Function AbsorbentClass(a, b, c, d, e, Optional crit As Variant = "TRUE") As Variant

f = 0.8
g = 1
h = 1
i = 1
j = 0.9

api = Application.MRound(((a + b + c + d + e) / 5), 0.05) 'check to compare whether average of api or sumref is higher
sumref = Application.MRound(((f + g + h + i + j) / 5), 0.05)

Udeviation1 = Application.If((f - a) > 0, f - a, 0)
Udeviation2 = Application.If((g - b) > 0, g - b, 0)
Udeviation3 = Application.If((h - c) > 0, h - c, 0)
Udeviation4 = Application.If((i - d) > 0, i - d, 0)
Udeviation5 = Application.If((j - e) > 0, j - e, 0)
Udevsum = Udeviation1 + Udeviation2 + Udeviation3 + Udeviation4 + Udeviation5 'setting the range for the ifsum below

If api < sumref Then
    Do While Udevsum <= 0.1 'whilst sum of positive unfavorable deviations are greater than 0.1, proceed to add 0.05 to each term (f-j)
        f = f - 0.05
        g = g - 0.05
        h = h - 0.05
        i = i - 0.05
        j = j - 0.05
        Udeviation1 = Application.If((f - a) > 0, f - a, 0)
        Udeviation2 = Application.If((g - b) > 0, g - b, 0)
        Udeviation3 = Application.If((h - c) > 0, h - c, 0)
        Udeviation4 = Application.If((i - d) > 0, i - d, 0)
        Udeviation5 = Application.If((j - e) > 0, j - e, 0)
        Udevsum = Udeviation1 + Udeviation2 + Udeviation3 + Udeviation4 + Udeviation5 'recalculate unfavorable deviations
    Loop

End If

AbsorbentClass = g

End Function

问题根源分析 #

• Application.SumIf参数不兼容：Excel工作表函数SumIf要求第一个参数是单元格区域，无法直接处理VBA数组，这是第二版代码触发#VALUE!错误的核心原因。
• Application.If误用：VBA中没有Application.If这个函数，应该使用原生的IIf函数，直接调用会导致类型不匹配错误。
• 循环逻辑矛盾：第三版代码中Do While Udevsum <= 0.1的判断条件与注释描述的“正偏差总和大于0.1时调整”完全相反，导致循环逻辑混乱。

修正后的完整代码 #

Function AbsorbentClass(a, b, c, d, e, Optional crit As Variant = True) As Variant
    Dim f As Double, g As Double, h As Double, i As Double, j As Double
    Dim api As Double, sumref As Double
    Dim uDevSum As Double
    
    ' 初始化基准值
    f = 0.8
    g = 1
    h = 1
    i = 1
    j = 0.9
    
    ' 计算api和初始sumref（按0.05取整）
    api = Application.MRound((a + b + c + d + e) / 5, 0.05)
    sumref = Application.MRound((f + g + h + i + j) / 5, 0.05)
    
    ' 计算正偏差总和的复用逻辑
    Function CalcUDevSum() As Double
        Dim tempSum As Double
        tempSum = 0
        If f - a > 0 Then tempSum = tempSum + (f - a)
        If g - b > 0 Then tempSum = tempSum + (g - b)
        If h - c > 0 Then tempSum = tempSum + (h - c)
        If i - d > 0 Then tempSum = tempSum + (i - d)
        If j - e > 0 Then tempSum = tempSum + (j - e)
        CalcUDevSum = tempSum
    End Function
    
    uDevSum = CalcUDevSum()
    
    ' 根据api和sumref的大小关系调整参数
    If api < sumref Then
        ' 正偏差总和≥0.1时，减小f-j向api靠近
        Do While uDevSum >= 0.1
            f = f - 0.05
            g = g - 0.05
            h = h - 0.05
            i = i - 0.05
            j = j - 0.05
            uDevSum = CalcUDevSum()
            ' 防止无限循环：避免参数小于0
            If f < 0 Or g < 0 Or h < 0 Or i < 0 Or j < 0 Then Exit Do
        Loop
    ElseIf api > sumref Then
        ' 负偏差绝对值总和≥0.1时，增大f-j向api靠近
        Do While CalcUDevSum() >= 0.1
            f = f + 0.05
            g = g + 0.05
            h = h + 0.05
            i = i + 0.05
            j = j + 0.05
            uDevSum = CalcUDevSum()
        Loop
    End If
    
    ' 处理返回结果
    If crit = True Then
        AbsorbentClass = g
    Else
        Select Case g
            Case Is < 0.15
                AbsorbentClass = "Not classified"
            Case 0.15 To 0.3
                AbsorbentClass = "E"
            Case 0.3 To 0.6
                AbsorbentClass = "D"
            Case 0.6 To 0.8
                AbsorbentClass = "C"
            Case 0.8 To 0.9
                AbsorbentClass = "B"
            Case Is >= 0.9
                AbsorbentClass = "A"
        End Select
    End If
End Function

关键修正说明 #

• 替换SumIf和Application.If：用VBA原生条件判断计算正偏差总和，避免工作表函数的类型不匹配问题。
• 修正循环逻辑：将矛盾的判断条件改为uDevSum >= 0.1，符合需求描述。
• 显式声明变量：添加Dim语句声明所有变量，避免隐式类型转换错误。
• 添加循环边界保护：防止参数被调整为负数，避免无限循环。
• 优化分类逻辑：用Select Case替代多层ElseIf，代码更简洁易读。

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