Excel VBA自定义CIRR函数计算IRR出现#VALUE!异常问题咨询

尝试用VBA编写CIRR函数计算保单IRR，输入参数为总保费、缴费年限、保单年限、预期终值，但遇到以下问题：

• 保单年限为10时能得到正确IRR值
• 改为3、30等其他年限，或终值低于某一数值时，函数返回#VALUE!错误
• 直接使用Excel内置IRR函数却能得到正确结果

现有代码如下：

Function CIRR(TotalPremiumPaid As Double, YearsOfPayment As Integer, PolicyYears As Integer, FinalValue As Double) As Double
    Dim EachValue As Double
    Dim CashFlow() As Double
    Dim n As Integer
    Dim InitialGuess As Double

    ' Calculate the annual premium payment
    EachValue = TotalPremiumPaid / YearsOfPayment

    ' Resize the cash flow array based on the total policy years
    ReDim CashFlow(0 To PolicyYears)

    ' Fill the cash flow array with negative values for the years of payment
    For n = 0 To YearsOfPayment - 1
        CashFlow(n) = -1 * EachValue
    Next n

    ' Fill the remaining years with zero (no cash flow)
    For n = YearsOfPayment To PolicyYears
        CashFlow(n) = 0
    Next n

    ' Add the final value at the end of the policy
    CashFlow(PolicyYears) = FinalValue
    
    ' Provide an initial guess for IRR calculation
    InitialGuess = 0.1 ' 10% as a starting point

    ' Calculate and return the IRR
    CIRR = IRR(CashFlow, InitialGuess)
End Function

核心问题 #

1. 固定初始猜测值导致收敛失败
   VBA的IRR函数对初始猜测值敏感度极高，你固定使用10%（0.1）作为初始值，当IRR实际值与该偏差过大时（比如终值过低导致IRR为负、长期保单IRR远低于10%），函数会因无法收敛返回错误。而Excel内置IRR会自动尝试多个初始值来找到收敛结果。

2. 函数返回类型限制
   你的函数声明为As Double，一旦IRR计算失败（无实数解或收敛失败），无法返回合法的错误值，只能抛出#VALUE!。Excel内置函数会处理这类情况并返回标准错误提示，自定义函数需要手动处理错误逻辑。

修复后的代码 #

Function CIRR(TotalPremiumPaid As Double, YearsOfPayment As Integer, PolicyYears As Integer, FinalValue As Double) As Variant
    Dim EachValue As Double
    Dim CashFlow() As Double
    Dim n As Integer
    Dim InitialGuesses As Variant
    Dim Guess As Variant
    Dim irrResult As Variant

    ' 计算年缴保费
    EachValue = TotalPremiumPaid / YearsOfPayment

    ' 调整现金流数组大小
    ReDim CashFlow(0 To PolicyYears)

    ' 填充缴费期的负现金流
    For n = 0 To YearsOfPayment - 1
        CashFlow(n) = -EachValue
    Next n

    ' 填充非缴费期的0现金流（注意避开最后一期）
    For n = YearsOfPayment To PolicyYears - 1
        CashFlow(n) = 0
    Next n

    ' 填充期末终值
    CashFlow(PolicyYears) = FinalValue
    
    ' 准备多组初始猜测值，覆盖IRR可能的范围
    InitialGuesses = Array(-0.5, -0.2, 0, 0.1, 0.2, 0.5, 0.8)

    ' 遍历猜测值尝试计算IRR
    For Each Guess In InitialGuesses
        On Error Resume Next
        irrResult = IRR(CashFlow, Guess)
        On Error GoTo 0
        ' 检查计算是否成功
        If Not IsError(irrResult) Then
            CIRR = irrResult
            Exit Function
        End If
    Next Guess

    ' 所有猜测值均失败，返回标准错误
    CIRR = CVErr(xlErrValue)
End Function

修复说明 #

• 多初始猜测值：提供从-50%到80%的多组初始值，覆盖保单IRR可能出现的大部分场景，大幅提升收敛成功率。
• 返回类型改为Variant：允许函数返回错误值（CVErr(xlErrValue)），与Excel内置函数的错误表现一致。
• 错误处理逻辑：用On Error Resume Next捕获单组猜测值的计算错误，跳过失败尝试后继续下一组，直到找到有效结果或遍历完所有猜测值。

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