如何在Delphi中实现XIRR实现？

Question

不久前，我在寻找一个体面的Delphi实现XIRR Excel函数，但我没有找到一个。

我必须自己想办法，希望这将成为其他Delphi/Object Pascal开发人员有用的参考。

请参见下面的答案。

- Alper TÖR

---

从FAQ中得知："只要你假装自己在玩Jeopardy!游戏，以问题的形式提出并回答自己的问题是完全可以的。" 但这个问题并不是一个问题的形式，很可能会被关闭。你应该编辑它，请求一个XIRR实现，并将代码作为答案发布。 - Cosmin Prund

我也想问XIRR是什么意思 ;) - Vladislav Rastrusny

同意@Cosmin Prund的观点。但是，由于本质上是编辑问题，这个问题不应该被关闭。 - JosephStyons

我在常见问题解答中错过了那部分内容。我会相应地进行编辑。 - Alper TÖR

答案将在一个小时内提供。 - Alper TÖR

Answer 1

与其重新发明轮子，我建议看看SysTools出色的StFIN.pas：

function NonperiodicIRR(const Values : array of Double; const Dates : array of TStDate; Guess : Extended) : Extended;

你可以在这里获取它：

http://sourceforge.net/projects/tpsystools

- cdoumar

---

谢谢您的建议。那时候我不知道这个。 - Alper TÖR

Answer 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; 

- Alper TÖR