如何在Delphi中实现XIRR实现?

时间:2011-06-14 09:42:11

标签: delphi pascal

前段时间,我一直在寻找XIRR Excel function的Delphi实现,但我找不到。

我必须提出自己的建议,希望对其他Delphi / Object Pascal开发人员有用。

请参阅下面的答案。

2 个答案:

答案 0 :(得分:4)

不是重新发明轮子,我会看看SysTools优秀的StFIN.pas:

function NonperiodicIRR(const值:Double数组;                           const日期:TStDate数组;                           猜猜:扩展):扩展;

你可以在这里抓住它:

http://sourceforge.net/projects/tpsystools

答案 1 :(得分:2)

这是代码;

function XIRR(Values: array of double; Dates: array of tDateTime; var Rate: double): Boolean;
const MAX_STEPS = 100;

    function CalcValue(Rate: double): double;
        function disc(d: tDateTime; v: double): double;
        var
            Exp, coef: double;
        begin
            Exp := (d - Dates[0]) / 365;
            coef := Power(1 + Rate / 100, Exp);
            result := v / coef;
         end;
    var
        i: integer;
    begin
        result := 0;
        for i := 0 to High(Dates) do
            result := result + disc(Dates[i], Values[i]);
    end;

var
    SaveFPUCW: word;
    CWChgReq: Boolean;
    Rate1, Rate2, RateN: double;
    F1, F2, FN, dF, Scale: double;
    Quit: Boolean;
    N: integer;
begin
    RateN := 0;
    FN := 0;
    Assert(length(Values) = length(Dates));
    Assert(length(Values) >= 2);
    SaveFPUCW := Get8087CW;
    CWChgReq := (SaveFPUCW and $1F3F) <> $1332;
    If CWChgReq then Set8087CW($1332);
    try
        result := true;
        Rate1 := Rate;
        Rate2 := Rate + 1;
        Quit := false;
        N := 0;
        Scale := 1;
        F1 := CalcValue(Rate1);
        F2 := CalcValue(Rate2);
        while not Quit do
        begin
            if (F2 = F1) or (Rate2 = Rate1) then
            begin
                Quit := true;
                result := false;
            end
            else
            begin
                dF := (F2 - F1) / (Rate2 - Rate1);
                RateN := Rate1 + (0 - F1) / dF / Scale;
                N := N + 1;
                if RateN > -100 then  := CalcValue(RateN);
                if Abs(RateN - Rate1) / ((Abs(Rate1) + Abs(Rate2)) / 2) < 0.0000005 then 
                    Quit := true
                else if N >= MAX_STEPS then
                begin
                    Quit := true;
                    result := false;
                end
                else if not(RateN > -100) then
                begin
                    Scale := Scale * 2;
                end
                else
                begin
                    Scale := 1;
                    Rate2 := Rate1;
                    F2 := F1;
                    Rate1 := RateN;
                    F1 := FN;
                end;
            end;
        end;
        if result then Rate := RateN
        else Rate := 0;
    Finally
        If CWChgReq then Set8087CW(SaveFPUCW);
    end;
end;