如何在Delphi中实现XIRR实现？

Question

前段时间，我一直在寻找一个漂亮的Delphi执行XIRR Excel function，但我无法找到一个。

我不得不想出我自己的，我希望它会成为其他Delphi/Object Pascal开发人员的有用参考。

请参阅下面的答案。

Answer 1

而不是重新发明轮子，我想看看SysTools的优良StFIN.pas：

功能NonperiodicIRR（常量值：双阵列; 常量日期：TStDate的阵列; 猜测：扩展）：扩展;

你可以在这里抓住它：

http://sourceforge.net/projects/tpsystools

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;