以文本方式查看主题

-  Foxtable(狐表)  (http://www.foxtable.com/bbs/index.asp)
--  专家坐堂  (http://www.foxtable.com/bbs/list.asp?boardid=2)
----  [求助]foxtable有办法实现irr\xirr的计算吗?  (http://www.foxtable.com/bbs/dispbbs.asp?boardid=2&id=145122)

--  作者:leeswayne
--  发布时间:2020/1/9 9:41:00
--  [求助]foxtable有办法实现irr\xirr的计算吗?
老师您好,求助一个问题。

excel中有一个公式,是irr、xirr的,也就是针对一列日期和一列对应的收支,可以计算收益率。

但是foxtable中的函数都较为简单,是否有办法实现这一功能?

--  作者:有点蓝
--  发布时间:2020/1/9 9:55:00
--  
表达式函数是没有办法了,使用代码才可以,参考:http://www.foxtable.com/webhelp/topics/1344.htm
--  作者:leeswayne
--  发布时间:2020/1/9 10:04:00
--  
谢谢,看到了,后期版本是否可以增加XIRR这一代码。目前只有IRR和MIRR。
--  作者:有点蓝
--  发布时间:2020/1/9 11:08:00
--  
XIRR网上找到一个算法,至于合适不合适自己测试

全局代码

Class SurroundingClass
    Public Const tol As Double = 0.001
    Public Delegate Function fx(ByVal x As Double) As Double

    Public Shared Function composeFunctions(ByVal f1 As fx, ByVal f2 As fx) As fx
        Return Function(ByVal x As Double) f1(x) + f2(x)
    End Function

    Public Shared Function f_xirr(ByVal p As Double, ByVal dt As Double, ByVal dt0 As Double) As fx
        Return Function(ByVal x As Double) p * Math.Pow((1.0 + x), ((dt0 - dt) / 365.0))
    End Function

    Public Shared Function df_xirr(ByVal p As Double, ByVal dt As Double, ByVal dt0 As Double) As fx
        Return Function(ByVal x As Double) (1.0 / 365.0) * (dt0 - dt) * p * Math.Pow((x + 1.0), (((dt0 - dt) / 365.0) - 1.0))
    End Function

    Public Shared Function total_f_xirr(ByVal payments As Double(), ByVal days As Double()) As fx
        Dim resf As fx = Function(ByVal x As Double) 0.0

        For i As Integer = 0 To payments.Length - 1
            resf = composeFunctions(resf, f_xirr(payments(i), days(i), days(0)))
        Next

        Return resf
    End Function

    Public Shared Function total_df_xirr(ByVal payments As Double(), ByVal days As Double()) As fx
        Dim resf As fx = Function(ByVal x As Double) 0.0

        For i As Integer = 0 To payments.Length - 1
            resf = composeFunctions(resf, df_xirr(payments(i), days(i), days(0)))
        Next

        Return resf
    End Function

    Public Shared Function Newtons_method(ByVal guess As Double, ByVal f As fx, ByVal df As fx) As Double
        Dim x0 As Double = guess
        Dim x1 As Double = 0.0
        Dim err As Double = 1.0E+100

        While err > tol
            x1 = x0 - f(x0) / df(x0)
            err = Math.Abs(x1 - x0)
            x0 = x1
        End While

        Return x0
    End Function
End Class

测试代码

Dim val1() As Double = {4166.67, -4166.67, -4166.67, -4166.67}
Dim val2() As Double = {New Date(2014, 9, 1).DayOfYear, New Date(2014, 10, 1).DayOfYear, New Date(2014, 11, 1).DayOfYear, New Date(2014, 12, 1).DayOfYear}

Dim xirr = SurroundingClass.Newtons_method(0.1, SurroundingClass.total_f_xirr(val1, val2),SurroundingClass.total_df_xirr(val1, val2))
MsgBox(xirr)
[此贴子已经被作者于2020/1/9 11:08:37编辑过]