MENU
Главная » Статьи » Без категории
Расчет IRR
Public Function tadEFFECT(ByVal rate As Double, ByVal compounding As Double)
If compounding = 0 Then
tadEFFECT = Exp(rate) - 1
Else
tadEFFECT = (1 + rate * compounding) ^ (1 / compounding) - 1
End If
End Function

Public Function tadPVIF(ByVal rate As Double, ByVal N As Double, ByVal compounding As Double)
tadPVIF = (1 + tadEFFECT(rate, compounding)) ^ (-N)
End Function

Public Function tadPVIFbar(ByVal rate As Double, ByVal N As Double, ByVal compounding As Double)
If (compounding = 0) Then
tadPVIFbar = -N * tadPVIF(rate, N, compounding)
Else
tadPVIFbar = -N / compounding * tadPVIF(rate, N, compounding)
End If
End Function

Public Function tadXNPV(ByVal rate As Double, ByRef ValuesArr() As Double, ByRef DatesArr() As Long, ByVal compounding As Double) As Double

Dim i As Long
Dim t As Double
Dim npv As Double

npv = 0

For i = 0 To UBound(ValuesArr)
t = (DatesArr(i) - DatesArr(0)) / 365
npv = npv + ValuesArr(i) * tadPVIF(rate, t, compounding)
Next i

tadXNPV = npv

End Function

Public Function tadXNPVbar(ByVal rate As Double, ByRef ValuesArr() As Double, ByRef DatesArr() As Long, ByVal compounding As Double) As Double

Dim rCell As Range
Dim i As Long
Dim t As Double
Dim npv As Double

npv = 0

For i = 0 To UBound(ValuesArr)
t = (DatesArr(i) - DatesArr(0)) / 365
npv = npv + ValuesArr(i) * tadPVIFbar(rate, t + compounding, compounding)
Next i

tadXNPVbar = npv

End Function

Public Function IsRealPower(ByRef DatesArr() As Long) As Boolean
'если корректно указаны даты
Dim i As Long
Dim N As Double
Dim IsReal As Boolean

IsReal = False

For i = 1 To UBound(DatesArr)
N = (DatesArr(i) - DatesArr(0)) / 365
If (N - Int(N)) <> 0 Then
IsReal = True
Exit For
End If

Next i
IsRealPower = IsReal
End Function

Public Function EducatedGuessXIRR(ByRef ValuesArr() As Double, ByRef DatesArr() As Long, ByVal guess As Double, ByVal compounding As Double) As Double

Dim B As Double
Dim C As Double
Dim i As Long
Dim N As Double
Dim HPR As Double
Dim AHPY As Double

B = 0
C = 0

For i = 0 To UBound(ValuesArr)
If ValuesArr(i) > 0 Then
B = B + ValuesArr(i)
Else
C = C + Abs(ValuesArr(i))
End If
Next i

N = (DatesArr(UBound(DatesArr)) - DatesArr(0)) / 365

If ((B <> 0) And (C <> 0)) Then
HPR = B / C
AHPY = HPR ^ (compounding / N) - 1
AHPY = AHPY / compounding
EducatedGuessXIRR = AHPY
Else
EducatedGuessXIRR = guess
End If

End Function

Public Function EducatedGuessIRR(ByRef ValuesArr() As Double, ByRef DatesArr() As Long, ByVal guess As Double, ByVal compounding As Double) As Double

Dim B As Double
Dim C As Double
Dim i As Long
Dim HPR As Double
Dim HPY As Double

B = 0
C = 0

For i = 0 To UBound(ValuesArr)
If ValuesArr(i) > 0 Then
B = B + ValuesArr(i)
Else
C = C + Abs(ValuesArr(i))
End If
Next i

If ((B <> 0) And (C <> 0)) Then
HPR = B / C
HPY = HPR - 1
HPY = HPY / compounding
EducatedGuessIRR = HPY
Else
EducatedGuessIRR = guess
End If

End Function

Public Function tadXIRR(ByVal Values As Range, ByVal Dates As Range, Optional ByRef guess As Double = 0.1, Optional ByRef compounding As Double = 1#) As Double

Dim f As Double
Dim fbar As Double
Dim x As Double
Dim x0 As Double
Dim i As Integer
Dim found As Integer
Dim rCell As Range
Dim ValuesArr() As Double
Dim DatesArr() As Long
ReDim ValuesArr(Values.Count - 1)
ReDim DatesArr(Values.Count - 1)

i = 0
For Each rCell In Values.Cells
ValuesArr(i) = rCell.Value
i = i + 1
Next rCell

i = 0
For Each rCell In Dates.Cells
DatesArr(i) = DateValue(rCell.Value)
i = i + 1
Next rCell

found = 0
i = 1

' если предположение (guess) задано (по умолчанию 0.1)
If guess = 0.1 Then
    ' если указаны корректно даты
    If IsRealPower(DatesArr()) Then
        x0 = EducatedGuessXIRR(ValuesArr(), DatesArr(), guess, compounding)
    Else
        x0 = EducatedGuessIRR(ValuesArr(), DatesArr(), guess, compounding)
    End If
Else
    x0 = guess
End If

Do While (i < 100)

f = tadXNPV(x0, ValuesArr(), DatesArr(), compounding)
fbar = tadXNPVbar(x0, ValuesArr(), DatesArr(), compounding)

If (fbar = 0) Then
tadXIRR = (0) ^ (-1)
Else
x = x0 - f / fbar
End If

If (Abs(x - x0) < 0.000001) Then
found = 1
Exit Do
End If

x0 = x
i = i + 1

Loop

If (found = 1) Then
tadXIRR = x
Else
tadXIRR = (-1) ^ (0.5)
End If

End Function

 
Категория: Без категории | Добавил: clownsaround (29.09.2017)
Просмотров: 336 | Теги: IRR | Рейтинг: 0.0/0
Всего комментариев: 0
Войдите:
avatar