Excel VBA：计算给定的法国分期付款计划的近似利率：起始本金、定期付款金额、年数
Excel VBA: compute an approximate interest rate of a french amortization schedule given: Starting Principal, Periodic Payment Amount, Nr Of Years
我需要计算（近似）法国分期付款计划（一系列定期等额付款）的利率，给定：
- 起始校长
- 定期还款额度（本息）
- 摊销计划的年数。
没有 direct/easy 方法可以用数学公式计算利率，我不喜欢 RATE excel 公式 ( https://support.office.com/en-us/article/RATE-function-9f665657-4a7e-4bb7-a030-83fc59e748ce )，因为我需要一些易于移植的代码其他语言（我目前正在开发一个 C# 库来进行一些财务计算）。
一些关于摊销的维基百科参考如下：
仅针对年利息提供计算应该没有实质性区别。事实上，从每年到每月，利息差异大约是 10 年 0,005 和 30 年 0,0025。
ExcelVBA代码如下，如果有人有任何改进建议，欢迎提出。
' compute the Annual Interest Rate of a french amortization schedule (a series of equal payments at regular intervals) given:
' > the Starting Principal
' > the Periodic Payment Amount (Principal And Interests)
' > the Yearly Nr Of payments
' > the Total Nr Of payments
'
' returns the interest truncated to 2 decimals (for 7,525% returns 0,0752)
' returns Null if the interest rate is not computable
'
' examples:
' > the Starting Principal = 10000
' > the Periodic Payment Amount (Principal And Interests) = 1423.78
' > the Yearly Nr Of payments = 1
' > the Total Nr Of payments = 10
' >>> returns 0,07 (i.e. 7%)
'
' uses the functions:
' > ComputePeriodicPaymentAmountWInterestConstPaymConstRateLoan
'
Public Function ComputeIRateConstPaymLoan(StartingPrincipal, PeriodicPaymentAmountPrincipalAndInterests, NrOfYearlyPayments, NrOfTotalPayments)
Dim IMin, IMax, AComputed, LoopLevel, LoopCount, LoopIIncrement, LoopICurrent, LoopFloorI, LoopFloorA, DebugLoopCounter
IMin = (0.00001) / 100
IMax = (99.99999) / 100
' Compute the Annuity (the Periodic Payment Amount) with the minimum rate
AComputed = ComputePeriodicPaymentAmountWInterestConstPaymConstRateLoan(IMin, NrOfYearlyPayments, NrOfTotalPayments, StartingPrincipal)
' if the given "Periodic Payment Amount" is equal to the computed Annuity returns the interest rate used for the computation
If PeriodicPaymentAmountPrincipalAndInterests = AComputed Then
' returns IMin
ComputeIRateConstPaymLoan = IMin
' exit from the function
Exit Function
End If
' Returns Error Value (Null) if the given "Periodic Payment Amount" is less than the computed Annuity
If PeriodicPaymentAmountPrincipalAndInterests < AComputed Then
ComputeIRateConstPaymLoan = Null
Exit Function
End If
' Compute the Annuity (the Periodic Payment Amount) with the maximum rate
AComputed = ComputePeriodicPaymentAmountWInterestConstPaymConstRateLoan(IMax, NrOfYearlyPayments, NrOfTotalPayments, StartingPrincipal)
' if the given "Periodic Payment Amount" is equal to the computed Annuity returns the interest rate used for the computation
If PeriodicPaymentAmountPrincipalAndInterests = AComputed Then
' returns IMax
ComputeIRateConstPaymLoan = IMax
' exit from the function
Exit Function
End If
' Returns Error Value (Null) if the given "Periodic Payment Amount" is greater than the computed Annuity
If PeriodicPaymentAmountPrincipalAndInterests > AComputed Then
ComputeIRateConstPaymLoan = Null
Exit Function
End If
' loop
'
' loop steps:
' 1> from IMin, increments of 0,05
' 2> from the floor rate computed in the previous step, increments of 0,02
' 3> from the floor rate computed in the previous step, increments of 0,005
' 4> from the floor rate computed in the previous step, increments of 0,0005
' 5> from the floor rate computed in the previous step, increments of 0,00005
'
' set the counter to the first level
LoopLevel = 1
' reset the loop counter to count loop cycles needed to find the rate (deactivate this in production)
DebugLoopCounter = 0
' loop to find the rate
Do
' test the loop level
Select Case LoopLevel
' Level 1> from IMin, increments of 0,05
Case 1
' set loop parameters
LoopIIncrement = 0.05
LoopICurrent = IMin
' Level 2> from the floor rate computed in the previous step, increments of 0,02
Case 2
' set loop parameters
LoopIIncrement = 0.02
LoopICurrent = LoopFloorI
' Level 3> from the floor rate computed in the previous step, increments of 0,005
Case 3
' set loop parameters
LoopIIncrement = 0.005
LoopICurrent = LoopFloorI
' Level 4> from the floor rate computed in the previous step, increments of 0,0005
Case 4
' set loop parameters
LoopIIncrement = 0.0005
LoopICurrent = LoopFloorI
' Level 5> from the floor rate computed in the previous step, increments of 0,00005
Case 5
' set loop parameters
LoopIIncrement = 0.00005
LoopICurrent = LoopFloorI
' exit from the loop and return the last rate
Case 6
' returns LoopICurrent truncated to 2 decimals
ComputeIRateConstPaymLoan = Fix(LoopICurrent * 10000) / 10000
' exit from the function
Exit Function
End Select
' loop until the computed Annuity is not greater than the given "Periodic Payment Amount"
Do
' increments the debug counter
DebugLoopCounter = DebugLoopCounter + 1
' increments the current interest rate
LoopICurrent = LoopICurrent + LoopIIncrement
' compute the Annuity with the current rate
AComputed = ComputePeriodicPaymentAmountWInterestConstPaymConstRateLoan(LoopICurrent, NrOfYearlyPayments, NrOfTotalPayments, StartingPrincipal)
' if the given "Periodic Payment Amount" is equal to the computed Annuity returns the interest rate used for the computation
If PeriodicPaymentAmountPrincipalAndInterests = AComputed Then
' returns LoopICurrent
ComputeIRateConstPaymLoan = LoopICurrent
' exit from the function
Exit Function
End If
' if the computed Annuity is grater than the given "Periodic Payment Amount" exit loop
If AComputed > PeriodicPaymentAmountPrincipalAndInterests Then
' exit loop
Exit Do
' if the computed Annuity is less than the given "Periodic Payment Amount" save Floor rate and exit loop
Else
' save Floor rate
LoopFloorA = AComputed
LoopFloorI = LoopICurrent
End If
' END - loop until the computed Annuity is not greater than the given "Periodic Payment Amount"
Loop
' increments the loop level counter
LoopLevel = LoopLevel + 1
' END - loop to find the rate
Loop
End Function
' compute the Periodic Payment Amount (Principal And Interests)(la rata periodica) of a french amortization schedule (a series of equal payments at regular intervals) given:
' > the Annual Interest Rate
' > the Yearly Nr Of payments
' > the Total Nr Of payments
' > the Starting Principal
'
' returns the Periodic Payment Amount, made of Principal And Interests
'
' examples:
' > the Annual Interest Rate = 0.07 (7%)
' > the Nr Of payments = 120
' > the Starting Principal = 10000
' >>> returns 1423,77502727365
'
' used by:
' > ComputeIRateConstPaymLoan
'
Public Function ComputePeriodicPaymentAmountWInterestConstPaymConstRateLoan(AnnualInterestRate, NrOfYearlyPayments, NrOfTotalPayments, StartingPrincipal)
' Starting principal 10.000, Annual interest rate 0.07 (7%), 120 total payments, 1 payments for year, Periodic Payment Amount 1.423,78
Dim i, nt, ny, p, A
i = AnnualInterestRate
nt = NrOfTotalPayments
ny = NrOfYearlyPayments
p = StartingPrincipal
' calcola la rata iniziale (la formula funziona con qualunque durata e periodicità)
A = p * (i / ny) / (1 - (1 / (1 + (i / ny)) ^ nt))
ComputePeriodicPaymentAmountWInterestConstPaymConstRateLoan = A
End Function
Sub test()
Dim Result
'Result = ComputeIRateConstPaymLoan(10000, 1423.78, 1, 10) ' result 7%
Result = ComputeIRateConstPaymLoan(10000, 116.1, 12, 120) ' result 7%
'Result = ComputeIRateConstPaymLoan(10000, 9700, 1, 10) ' result 96,89%
'Result = ComputeIRateConstPaymLoan(10000, 900, 1, 10) ' error, annuity less than the minimum allowed
'Result = ComputeIRateConstPaymLoan(10000, 100000000, 1, 10) ' error, annuity greater than the maximum allowed
'
'Result = ComputePeriodicPaymentAmountWInterestConstPaymConstRateLoan(0.07, 1, 10, 10000) ' result 1423,77502727365
'Result = ComputePeriodicPaymentAmountWInterestConstPaymConstRateLoan(0.07, 12, 120, 10000) ' result 116,108479218624
If IsNull(Result) Then
MsgBox "Errore"
Else
Debug.Print Result
Debug.Print Result * 1000
End If
End Sub
我需要计算（近似）法国分期付款计划（一系列定期等额付款）的利率，给定：
- 起始校长
- 定期还款额度（本息）
- 摊销计划的年数。
没有 direct/easy 方法可以用数学公式计算利率，我不喜欢 RATE excel 公式 ( https://support.office.com/en-us/article/RATE-function-9f665657-4a7e-4bb7-a030-83fc59e748ce )，因为我需要一些易于移植的代码其他语言（我目前正在开发一个 C# 库来进行一些财务计算）。
一些关于摊销的维基百科参考如下：
仅针对年利息提供计算应该没有实质性区别。事实上，从每年到每月，利息差异大约是 10 年 0,005 和 30 年 0,0025。
ExcelVBA代码如下，如果有人有任何改进建议，欢迎提出。
' compute the Annual Interest Rate of a french amortization schedule (a series of equal payments at regular intervals) given:
' > the Starting Principal
' > the Periodic Payment Amount (Principal And Interests)
' > the Yearly Nr Of payments
' > the Total Nr Of payments
'
' returns the interest truncated to 2 decimals (for 7,525% returns 0,0752)
' returns Null if the interest rate is not computable
'
' examples:
' > the Starting Principal = 10000
' > the Periodic Payment Amount (Principal And Interests) = 1423.78
' > the Yearly Nr Of payments = 1
' > the Total Nr Of payments = 10
' >>> returns 0,07 (i.e. 7%)
'
' uses the functions:
' > ComputePeriodicPaymentAmountWInterestConstPaymConstRateLoan
'
Public Function ComputeIRateConstPaymLoan(StartingPrincipal, PeriodicPaymentAmountPrincipalAndInterests, NrOfYearlyPayments, NrOfTotalPayments)
Dim IMin, IMax, AComputed, LoopLevel, LoopCount, LoopIIncrement, LoopICurrent, LoopFloorI, LoopFloorA, DebugLoopCounter
IMin = (0.00001) / 100
IMax = (99.99999) / 100
' Compute the Annuity (the Periodic Payment Amount) with the minimum rate
AComputed = ComputePeriodicPaymentAmountWInterestConstPaymConstRateLoan(IMin, NrOfYearlyPayments, NrOfTotalPayments, StartingPrincipal)
' if the given "Periodic Payment Amount" is equal to the computed Annuity returns the interest rate used for the computation
If PeriodicPaymentAmountPrincipalAndInterests = AComputed Then
' returns IMin
ComputeIRateConstPaymLoan = IMin
' exit from the function
Exit Function
End If
' Returns Error Value (Null) if the given "Periodic Payment Amount" is less than the computed Annuity
If PeriodicPaymentAmountPrincipalAndInterests < AComputed Then
ComputeIRateConstPaymLoan = Null
Exit Function
End If
' Compute the Annuity (the Periodic Payment Amount) with the maximum rate
AComputed = ComputePeriodicPaymentAmountWInterestConstPaymConstRateLoan(IMax, NrOfYearlyPayments, NrOfTotalPayments, StartingPrincipal)
' if the given "Periodic Payment Amount" is equal to the computed Annuity returns the interest rate used for the computation
If PeriodicPaymentAmountPrincipalAndInterests = AComputed Then
' returns IMax
ComputeIRateConstPaymLoan = IMax
' exit from the function
Exit Function
End If
' Returns Error Value (Null) if the given "Periodic Payment Amount" is greater than the computed Annuity
If PeriodicPaymentAmountPrincipalAndInterests > AComputed Then
ComputeIRateConstPaymLoan = Null
Exit Function
End If
' loop
'
' loop steps:
' 1> from IMin, increments of 0,05
' 2> from the floor rate computed in the previous step, increments of 0,02
' 3> from the floor rate computed in the previous step, increments of 0,005
' 4> from the floor rate computed in the previous step, increments of 0,0005
' 5> from the floor rate computed in the previous step, increments of 0,00005
'
' set the counter to the first level
LoopLevel = 1
' reset the loop counter to count loop cycles needed to find the rate (deactivate this in production)
DebugLoopCounter = 0
' loop to find the rate
Do
' test the loop level
Select Case LoopLevel
' Level 1> from IMin, increments of 0,05
Case 1
' set loop parameters
LoopIIncrement = 0.05
LoopICurrent = IMin
' Level 2> from the floor rate computed in the previous step, increments of 0,02
Case 2
' set loop parameters
LoopIIncrement = 0.02
LoopICurrent = LoopFloorI
' Level 3> from the floor rate computed in the previous step, increments of 0,005
Case 3
' set loop parameters
LoopIIncrement = 0.005
LoopICurrent = LoopFloorI
' Level 4> from the floor rate computed in the previous step, increments of 0,0005
Case 4
' set loop parameters
LoopIIncrement = 0.0005
LoopICurrent = LoopFloorI
' Level 5> from the floor rate computed in the previous step, increments of 0,00005
Case 5
' set loop parameters
LoopIIncrement = 0.00005
LoopICurrent = LoopFloorI
' exit from the loop and return the last rate
Case 6
' returns LoopICurrent truncated to 2 decimals
ComputeIRateConstPaymLoan = Fix(LoopICurrent * 10000) / 10000
' exit from the function
Exit Function
End Select
' loop until the computed Annuity is not greater than the given "Periodic Payment Amount"
Do
' increments the debug counter
DebugLoopCounter = DebugLoopCounter + 1
' increments the current interest rate
LoopICurrent = LoopICurrent + LoopIIncrement
' compute the Annuity with the current rate
AComputed = ComputePeriodicPaymentAmountWInterestConstPaymConstRateLoan(LoopICurrent, NrOfYearlyPayments, NrOfTotalPayments, StartingPrincipal)
' if the given "Periodic Payment Amount" is equal to the computed Annuity returns the interest rate used for the computation
If PeriodicPaymentAmountPrincipalAndInterests = AComputed Then
' returns LoopICurrent
ComputeIRateConstPaymLoan = LoopICurrent
' exit from the function
Exit Function
End If
' if the computed Annuity is grater than the given "Periodic Payment Amount" exit loop
If AComputed > PeriodicPaymentAmountPrincipalAndInterests Then
' exit loop
Exit Do
' if the computed Annuity is less than the given "Periodic Payment Amount" save Floor rate and exit loop
Else
' save Floor rate
LoopFloorA = AComputed
LoopFloorI = LoopICurrent
End If
' END - loop until the computed Annuity is not greater than the given "Periodic Payment Amount"
Loop
' increments the loop level counter
LoopLevel = LoopLevel + 1
' END - loop to find the rate
Loop
End Function
' compute the Periodic Payment Amount (Principal And Interests)(la rata periodica) of a french amortization schedule (a series of equal payments at regular intervals) given:
' > the Annual Interest Rate
' > the Yearly Nr Of payments
' > the Total Nr Of payments
' > the Starting Principal
'
' returns the Periodic Payment Amount, made of Principal And Interests
'
' examples:
' > the Annual Interest Rate = 0.07 (7%)
' > the Nr Of payments = 120
' > the Starting Principal = 10000
' >>> returns 1423,77502727365
'
' used by:
' > ComputeIRateConstPaymLoan
'
Public Function ComputePeriodicPaymentAmountWInterestConstPaymConstRateLoan(AnnualInterestRate, NrOfYearlyPayments, NrOfTotalPayments, StartingPrincipal)
' Starting principal 10.000, Annual interest rate 0.07 (7%), 120 total payments, 1 payments for year, Periodic Payment Amount 1.423,78
Dim i, nt, ny, p, A
i = AnnualInterestRate
nt = NrOfTotalPayments
ny = NrOfYearlyPayments
p = StartingPrincipal
' calcola la rata iniziale (la formula funziona con qualunque durata e periodicità)
A = p * (i / ny) / (1 - (1 / (1 + (i / ny)) ^ nt))
ComputePeriodicPaymentAmountWInterestConstPaymConstRateLoan = A
End Function
Sub test()
Dim Result
'Result = ComputeIRateConstPaymLoan(10000, 1423.78, 1, 10) ' result 7%
Result = ComputeIRateConstPaymLoan(10000, 116.1, 12, 120) ' result 7%
'Result = ComputeIRateConstPaymLoan(10000, 9700, 1, 10) ' result 96,89%
'Result = ComputeIRateConstPaymLoan(10000, 900, 1, 10) ' error, annuity less than the minimum allowed
'Result = ComputeIRateConstPaymLoan(10000, 100000000, 1, 10) ' error, annuity greater than the maximum allowed
'
'Result = ComputePeriodicPaymentAmountWInterestConstPaymConstRateLoan(0.07, 1, 10, 10000) ' result 1423,77502727365
'Result = ComputePeriodicPaymentAmountWInterestConstPaymConstRateLoan(0.07, 12, 120, 10000) ' result 116,108479218624
If IsNull(Result) Then
MsgBox "Errore"
Else
Debug.Print Result
Debug.Print Result * 1000
End If
End Sub