这是我多年前写的IRR Excel宏。我无法解释它是如何工作的,但我认为它做了正确的事情:
它的调用方式是:=IrrCont(A8:A15,F8:F15),其中第一个范围是日期范围,第二个范围是值范围。有些值必须是正的,有些值必须是负的。
Option Explicit
'
' Internal Rate of return -- Calculation
' Returns a result (Double) or an error message (String)
Private Function IrrCalc(DateRange As Object, ValueRange As Object)
Dim i As Integer
Dim it As Integer
Dim Count As Integer
Dim u As Double
Dim time As Double
Dim d_positive As Double
Dim positive As Double
Dim d_negative As Double
Dim negative As Double
Dim sum As Double
Const epsilon As Double = 0.000001
Const iterations As Integer = 20
Dim StartTime As Double
Dim pos As Boolean
Dim neg As Boolean
Dim value As Double
Dim temp As Double
Dim delta As Double
If DateRange.Count <> ValueRange.Count Then
IrrCalc = "*** Date Range (argument 1) and Value Range " & _
"(argument 2) must contain the same number of cells. ***"
Exit Function
End If
Count = DateRange.Count
For i = 1 To Count
If ValueRange.Cells(i).value > 0 Then pos = True
If ValueRange.Cells(i).value < 0 Then neg = True
If pos And neg Then Exit For
Next i
If Not pos Or Not neg Then
IrrCalc = "*** Cannot calculate IRR: Need both income and expenditure. ***"
Exit Function
End If
StartTime = Application.Min(DateRange)
u = 0 ' Initial interest rate guess
For it = 1 To iterations
positive = 0
d_positive = 0
negative = 0
d_negative = 0
For i = 1 To Count
value = ValueRange.Cells(i).value
time = (DateRange.Cells(i).value - StartTime) / 365.2425
If value > 0 Then
temp = value * Exp(u * time)
positive = positive + temp
d_positive = d_positive + temp * time
ElseIf value < 0 Then
temp = -value * Exp(u * time)
negative = negative + temp
d_negative = d_negative + temp * time
End If
Next i
delta = Log(negative / positive) / (d_negative / negative - d_positive / positive)
If Abs(delta) < epsilon Then Exit For
u = u - delta
Next it
If it > iterations Then
IrrCalc = "*** irr does not converge in " & Str(iterations) & " iterations ***"
Else
IrrCalc = u
End If
End Function
' ====================================================================================================
'
' Internal Rate of Return: Discrete interest calculation
Function IrrDiscrete(DateRange As Object, ValueRange As Object)
Dim result As Variant
result = IrrCalc(DateRange, ValueRange)
If VarType(result) = vbDouble Then
IrrDiscrete = Exp(-result) - 1#
Else
IrrDiscrete = result
End If
End Function
' ====================================================================================================
'
' Internal Rate of Return: Continuous (compounding) interest calculation
Function IrrCont(DateRange As Object, ValueRange As Object)
Dim result As Variant
result = IrrCalc(DateRange, ValueRange)
If VarType(result) = vbDouble Then
IrrCont = -result
Else
IrrCont = result
End If
End Function