(Excel用)裁判所における計算方法に従った利息計算を行う自作関数 INTCAL

裁判所における計算方法に従った利息計算を行うユーザー定義関数 INTCAL を作りました。
自作関数でExcel作業の幅を「すんごく」効率的にするには | Excel VBAのお勉強を参考にして、「標準モジュール」内に下記コードをコピペすると、シート上で INTCAL 関数が使えるようになります。
東京地方裁判所民事執行センター「さんまエクスプレス〈第40回〉債権執行書記官室の紹介(その1)債権受付係」金融法務事情1840号28頁やhttp://www.courts.go.jp/tokyo/vcms_lf/suk_risokukeisan_207.pdfに記載の方法、すなわち端数期間暦年閏年説で利息計算します。端数期間暦年閏年説については金利計算と閏年・端数処理について遅延損害金の計算方法 - 刑裁サイ太のゴ3ネタブログが詳しいです。裁判用利息単発計算の詳細情報 : Vector ソフトを探す!と同様の計算方法です。
VBAの DateDiff 関数は使い勝手が悪いので、ktDATEDIF(http://addinbox.sakura.ne.jp/Excel_Tips05.htm#ktDATEDIF2)を使用します。同ページからktDATEDIFのコードを引っ張ってきて追記するか、あるいはkt関数アドイン(http://addinbox.sakura.ne.jp/ktfunc_main.htm)を登録してください。

もし計算方法の誤りにお気づきの方は御指摘ください。
なお、計算の正確性を保証するものではないので、御利用は自己責任でお願いいたします。

使い方

=INTCAL(元金, 年利, 期間開始日, 期間終了日, [計算方法の指定, ][初日算入の指定, ][一円未満の端数処理の指定])

「計算方法の指定」以下は省略可です。省略した場合、「特約なし」「初日不算入(片端入れ)」「一円未満切捨」で計算します。「特約なし」は、端数期間暦年閏年説による計算を行います。

「計算方法の指定」には、0又は1又は2を入力してください。0は「特約なし」、1は「年365日日割計算」、2は「1年未満の端数部分につき年365日日割計算」です。何も入力しなければ「特約なし」となります。
「初日算入の指定」には、0又は1を入力してください。0は「初日不算入(片端入れ)」、1は「初日算入(両端入れ)」です。何も入力しなければ「初日不算入(片端入れ)」となります。
「一円未満の端数処理の指定」には、0又は1又は2を入力してください。0は「切捨」、1は「四捨五入」、2は「切上」です。何も入力しなければ「切捨」となります。

使用例

http://www.courts.go.jp/tokyo/vcms_lf/suk_risokukeisan_207.pdfの例を用います。すなわち、元金100,000円、年利は年18%として計算します。いずれも初日算入です。
(1) 特約なし 期間H3.8.2~H5.8.15

=INTCAL(100000, 0.18, "1991/8/2", "1993/8/15", 0, 1, 0) → 36690

(2) 特約なし 期間H3.8.2~H5.7.15

=INTCAL(100000, 0.18, "1991/8/2", "1993/7/15", 0, 1, 0) → 35141

(3) 年365日日割計算 期間H3.8.2~H5.7.15

=INTCAL(100000, 0.18, "1991/8/2", "1993/7/15", 1, 1, 0) → 35210

(4) 1年未満の端数部分につき年365日日割計算 期間H3.8.2~H5.7.15

=INTCAL(100000, 0.18, "1991/8/2", "1993/7/15", 2, 1, 0) → 35161

遅延損害金の計算方法 - 刑裁サイ太のゴ3ネタブログの例でも確認しておきます。元金100,000円、年利は年5%、期間はH20.4.2~H24.9.25、特約なし、初日算入、一円未満は四捨五入とします。

=INTCAL(100000, 0.05, "2008/4/2", "2012/9/25", 0, 1, 1) → 22418

ユーザー定義関数 INTCAL のコード本体

'裁判所における計算方法に従った利息計算(interest calculation)
Function INTCAL(元金 As Currency, 年利 As Double, 期間開始日 As Date, 期間終了日 As Date, _
                Optional 計算方法の指定 As Integer = 0, Optional 初日算入の指定 As Integer = 0, _
                Optional 一円未満の端数処理の指定 As Integer = 0)

    amount = 元金
    i = 年利
    date_begin = 期間開始日
    date_end = 期間終了日
    opt1 = 計算方法の指定
    opt2 = 初日算入の指定
    opt3 = 一円未満の端数処理の指定
    
    'opt1 計算方法の指定
    '       0(default)  特約なし
    '       1           年365日日割計算
    '       2           1年に満たない端数部分につき年365日日割計算
    'opt2 初日算入の指定
    '       0(default)  初日不算入
    '       1           初日算入
    'opt3 一円未満の端数処理の指定
    '       0(default)  切捨
    '       1           四捨五入
    '       2           切上
    
    Dim ans As Currency
    Dim y As Integer
    Dim m As Integer
    Dim d As Integer
    
    '初日算入の処理
    date_begin = date_begin - opt2
    
    '特約なし
    If opt1 = 0 Then
        y = ktDATEDIF(date_begin, date_end, "Y") '年数
        date_recent = DateAdd("yyyy", y, date_begin) '端数期間の初日
        
        '端数期間が同じ年の場合
        If year(date_recent) = year(date_end) Then
            d = ktDATEDIF(date_begin, date_end, "YD")
            If IsLeapYear(year(date_end)) Then '端数期間が閏年のときは端日数dを366で割る
                ans = amount * i * y + amount * i * d / 366
            Else '端数期間が平年のときは端日数dを365で割る
                ans = amount * i * y + amount * i * d / 365
            End If
        '端数期間が別の年の場合
        Else
            '端数期間に閏年が含まれるとき
            If IsLeapYear(year(date_recent)) Or IsLeapYear(year(date_end)) Then
                days_first = ktDATEDIF(date_recent, DateSerial(year(date_recent), 12, 31), "YD") '端数期間の先の方の年の日数
                days_second = ktDATEDIF(DateSerial(year(date_recent), 12, 31), date_end, "YD") '端数期間の後の方の年の日数
                '端数期間の先の方が閏年のとき
                If IsLeapYear(year(date_recent)) Then
                    ans = amount * i * y + amount * i * days_first / 366 + amount * i * days_second / 365
                '端数期間の後の方が閏年のとき
                Else
                    ans = amount * i * y + amount * i * days_first / 365 + amount * i * days_second / 366
                End If
            '端数期間がいずれも平年のとき
            Else
                d = DateDiff("d", date_recent, date_end)
                ans = amount * i * y + amount * i * d / 365
            End If
        End If
    
    '年365日日割計算
    ElseIf opt1 = 1 Then
        d = DateDiff("d", date_begin, date_end)
        ans = amount * i * d / 365
    
    '1年に満たない端数部分につき年365日日割計算
    ElseIf opt1 = 2 Then
        y = ktDATEDIF(date_begin, date_end, "Y")
        d = ktDATEDIF(date_begin, date_end, "YD")
        ans = amount * i * y + amount * i * d / 365
    
    End If
    
    '一円未満の端数処理
    Select Case opt3
    Case 1 '四捨五入
        ans = Application.WorksheetFunction.Round(ans, 0)
    Case 2 '切上
        ans = Application.WorksheetFunction.RoundUp(ans, 0)
    Case Else '切捨
        ans = Application.WorksheetFunction.RoundDown(ans, 0)
    End Select
    
    If ((opt1 = 0) Or (opt1 = 1) Or (opt1 = 2)) And ((opt2 = 0) Or (opt2 = 1)) And ((opt3 = 0) Or (opt3 = 1) Or (opt3 = 2)) Then
        INTCAL = ans
    Else 'optが指定の数字以外の場合にエラーを出す
        INTCAL = CVErr(xlErrValue)
    End If

End Function

'閏年判定
Function IsLeapYear(yyyy As Integer) As Boolean
    Dim b As Boolean
    If ((yyyy Mod 4) = 0 And (yyyy Mod 100) <> 0 Or (yyyy Mod 400) = 0) Then
        b = True
    Else
        b = False
    End If
    IsLeapYear = b
End Function

「関数ライブラリ」からダイアログボックスにより INTCAL 関数を利用する

下のSubプロシージャ RegisterINTCAL を実行すると、「関数ライブラリ」からダイアログボックスで関数 INTCAL を入力できます。
Excel ユーザー定義関数に機能説明や独自ヘルプをリンクする方法 – Japan Office Developer Support Blogを参考にしました。

Sub RegisterINTCAL()
    Application.MacroOptions Macro:="INTCAL", Description:="利息計算をする関数です。", _
    Category:="財務", ArgumentDescriptions:=Array("には利息計算の対象となる元金を指定します。", _
              "には年利を指定します。", _
              "には利息計算の対象となる期間の開始日を指定します。", _
              "には利息計算の対象となる期間の終了日を指定します。", _
              "0: 特約なし(default)" & vbCrLf & "1: 年365日日割計算" & vbCrLf & _
                                                 "2: 1年に満たない端数部分につき年365日日割計算", _
              "0: 初日不算入(default)" & vbCrLf & "1: 初日算入", _
              "0: 切捨(default)" & vbCrLf & "1: 四捨五入" & vbCrLf & "2: 切上"), _
    HelpFile:=""
End Sub

PERSONAL.XLSB の ThisWorkbook などに下のものを書いておくと、ブックを開くと自動的に RegisterINTCAL を実行するので便利です。これは
vba - When to set MacroOptions for Excel Addin - Stack Overflowを参考にしました。

Private WithEvents App As Application

Private Sub App_WorkbookActivate(ByVal Wb As Workbook)
    RegisterINTCAL
End Sub

Private Sub Workbook_Open()
    Set App = Application
End Sub

いろいろなブックで INTCAL 関数を使いたいときは

いろいろなブックで繰り返し INTCAL 関数を使う場合は、アドインを利用すると便利です。次のページを参考にしてください。
ユーザー定義関数を使う(アドイン) | オフィスソフト活用・業務効率化Q&Aブログ