使用VBA(债券)的摊销成本计算

时间:2019-04-01 14:57:24

标签: excel vba loops finance amortization

我正在尝试为摊销成本建立一个“会计”模型。我将制作一个包含实际付款日期的数组,一个包含“摊销成本”的数组,另一个显示报告日值的数组(例如31.12)。我已经手动进行了此操作,但是希望它通过更改输入数据来“一键式”执行这些操作。我刚接触VBA(才几天),还很挣扎,到目前为止,它在“付款日期”数组中苦苦挣扎,显示了债券上的现金流。

到目前为止,我有以下代码

Sub LoanAmortization()

'----------------------------------------------------------------------------------------------------------------------------------------------
'1)Define the arrays and variables that will be used along the process
'----------------------------------------------------------------------------------------------------------------------------------------------

'Dim Trends As Workbook                         'Variable to refer to the workbook

    Dim initLoanBal As Double         'Initial bond amount
    Dim DayCountBasis As Double       'Day count convention
    Dim BegDate As Date               'Date of bond repayment
    Dim MaturityDate As Date          'Date of bond repayment
    Dim TransCost As Double           'Transactioncosts on bonds
    Dim PayFreq As Double             'Frequency of coupon payments on bond (e.g. quarterly)
    Dim initRate As Double            'Interest rate on bond
    Dim CashFlowArray() As Integer    'Array of Cash flows on bond
    Dim CouponFreqString As String
    Dim NomRate As Double             'Rate used for cash flow calculation

    Dim i As Long
''----------------------------------------------------------------------------------------------------------------------------------------------
''2)Set variables for the calculation
''----------------------------------------------------------------------------------------------------------------------------------------------

    initLoanBal = ThisWorkbook.Worksheets("Amortisering").Range("D3").Value
    TransCost = Worksheets("Amortisering").Range("D4").Value
    initRate = Worksheets("Amortisering").Range("D5").Value
    Spread = Worksheets("Amortisering").Range("D6").Value
    DayCountBasis = Worksheets("Amortisering").Range("D7").Value
    CouponFreq = Worksheets("Amortisering").Range("E8").Value
    CouponFreqString = Worksheets("Amortisering").Range("D8").Value
    BegDate = Worksheets("Amortisering").Range("D9").Value
    MaturityDate = Worksheets("Amortisering").Range("D10").Value
    NomRate = initRate + Spread   

    '----------------------------------
    'Format variables for the calculation
    '----------------------------------
    Cells(5, 4).Select
    Selection.Value = initRate
    Selection.NumberFormat = "0.00%"


    Cells(6, 4).Select
    Selection.NumberFormat = "0.00%"


'-----------------------------------------------------------
'Set cash flows dates
'-----------------------------------------------------------
NoPeriods = DateDiff(CouponFreqString, BegDate, MaturityDate, vbMonday) 
' Number of periods ("payments") on the bond
    Range("G29") = BegDate
    Range("F31") = BegDate
    Range("G31").NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"

                For i = 1 To NoPeriods
                    Cells(29, 7 + i) = DateAdd(CouponFreqString, i, BegDate)
                    Cells(31 + i, 6) = DateAdd(CouponFreqString, i, BegDate)
                Next i
'----------------------------------------------
'Set number of days dager
'----------------------------------------------

    For i = 1 To NoPeriods  ' No. days between payments (daycount convention)
           Cells(30, 7 + i) = WorksheetFunction.YearFrac(Cells(29, 6 + i), Cells(29, 7 + i), DayCountBasis)
    Next i
'----------------------------------------------
'Cash flow array
'----------------------------------------------
    For c = 1 To NoPeriods
        For i = 1 To NoPeriods
                Cells(30 + i, 7 + c) = initLoanBal * NomRate * Cells(30, 7 + c)
               Next i
    Next c


Range("G31") = -initLoanBal + TransCost

End Sub

目标

因此问题出现在“现金流数组”部分。 1.最终目标是使用XIRR根据NomRate计算每个期间的实际利率。

  1. 我希望NomRate在每个期间都可以变化,因为浮动汇率有所变化。

  2. 我希望每行中的最终付款额等于利息付款额和贷款还款额(即initLoanBal)。

  3. 我希望第一个现金流量等于上期计算的摊余成本。

  4. 我希望每次迭代将Array减少1

请查看图片以获取其外观的插图(绿色值为下一个数组中的“摊销成本值”,即摊销成本值)

enter image description here

2 个答案:

答案 0 :(得分:0)

我建议您使用函数而不是宏来执行此操作。

该函数将充当Excel函数。例如,如果我执行一个名为TRIPLE的函数来计算3 * x,其中x是一个单元格编号,则可以在excel中使用TRIPLE(A1)来计算单元格A1中的三元组。

在您的示例中,经过您的澄清,我试图了解为您编写此代码的每一步,但是,复杂性并没有帮助我这样做。

但是我开始了一些事情。此功能的想法是,您指定所需的所有内容(以Hovedstol开头的单元格),日期,税金和结果索引。如果需要,可以按照我的说明添加任何内容。该函数的结果是Formel的计算。

示例:对于第一个结果,您应该使用excel进行调试:

=LoanAmortization(B2,B3,B4,B5,B6,F2:F20,G2:G20,1)

第二个结果:

=LoanAmortization(B2,B3,B4,B5,B6,F2:F20,G2:G20,1)

税收在G2:G20中组织。

因此,代码需要在vba的开头部分具有此参数才能用作功能:

Function LoanAmortization(A As Double, B As Double, C As Double, D As Double, E As Double, ByRef DatesRange As Excel.Range, ByRef TaxesRange As Excel.Range, MIndex As Integer) As Double
End Function

现在,您将需要使用数组来执行所需的任何操作,不需要格式化单元格,就可以多次创建所需的表格,并且代码仍然可以工作。 要创建数组,您首先需要指定元素数量,在此示例中,您可以创建一个矩阵,其中包含1到3的3列(如果未指定,则从0开始)和2的行,从1开始(相同,如果未指定,则0号是第一个):

Dim ArrayExample(1 to 2, 1 to 3) As Double

您也可以重新设置数组的格式,但是即使您使用save,也将丢失数据,无法更改变量类型。如果大小包含变量中的值,则需要使用ReDim:

ReDim ArrayExample(1 to 4, 0 to 3)

要将excel.range转换为数组,只需在声明后使用它即可:

ArrayExample = ArrayRange.Value

要使用矩阵,只需找到所需的行和列,例如:

ArrayExample(3, 2) = 1
i = ArrayExample(1) 'Just one column (have to be specified in declaration)
ArrayExample(0, 0) = "test"

要使用任何excel函数(例如CountA函数),只需使用以下代码:

Application.WorksheetFunction.CountA

这就是我所做的:

Function LoanAmortization(A As Double, B As Double, C As Double, D As Double, E As Double, ByRef DatesRange As Excel.Range, ByRef TaxesRange As Excel.Range, MIndex As Integer) As Double

    Dim qtd As Integer
    Dim Dates(), Taxes(), DatesDifference() As Double 'If bug, use Variant variable type
    qtd = Application.WorksheetFunction.CountA(DatesRange)
    ReDim DatesRange(1 to qtd), Taxes(1 to qtd), DatesDifference(1 to qtd - 1)
    For 1 to qtd - 1
        DatesDifference(i) = DatesRange(i + 1) - DatesRange(i)
    Next

End Function

有了这个,您应该可以继续执行代码,对不起,您没有更多帮助。如果您不确定如何进行更具体的操作,我会尽力帮助您。

答案 1 :(得分:0)

In my early VBA days, I built a loan re-payment calculator/scheduler as a learning project. The program takes input parameters from a Userform and calculates the loan repayment schedule. I will attach the file below for you to take a look at. The primary algorithm for calculating the loan payment schedule, is the Bisection algorithm. It is the same one that Excel's Goal Seek uses.

Note: The code is bit elementary, because as I mentioned earlier, I was just starting out, so I didn't know that I could pass parameters to Subs instead of making variables public, my variable naming was atrocious, and so on. That being said, I don't have the time to go back and make it robust, however the procedures are heavily commented, so I still think that you could learn from it.

File: Loan Repayment Calculator

Edit: Financial Modeling Using Excel and VBA by Chandan Sengupta is an excellent resource as well. I used several ideas from it to build my loan repayment calculator.

Below is the main Code for the calculations. Note that Each of The following variables are set in a userform, but they can be set to cells instead: IntsRate, loanLife, PrcplBal, ymtFrqy, CompFrqy, IntvlLng, VariDateIntvl, UserDate

Public IntsRate As Double, loanLife As String, PrcplBal As Double, PymtFrqy As String, CompFrqy As String, _
IntvlLng As Integer, VariDateIntvl As Integer
Public UserDate As Date
Option Explicit
Option Private Module
Public Sub LoanTableCalculations()

 Dim LR As Long, numOfIterations As Long, iCol As Long, pCol As Long, rNum As Long, outrow As Long
 Dim balTolerance As Double
 Dim yrBegBal() As Double, yrEndBal() As Double, ipPay() As Double, finalBal As Double 
 Dim annualPmnt As Double, aPmtOld As Double

    Application.ScreenUpdating = False

    '************************************************************
    ' User inputs
    '************************************************************
     'Read the date entered by user on the userform
    UserDate = LoanUserform.txtPymtBegn.Value 'start of payments

    'Conditionally set date interval and row headers _
    based on user input
    If PymtFrqy = "Annually" Then
       VariDateIntvl = 12
            Cells(8, 4).Value2 = "Year"
            Cells(8, 5).Value2 = "Year Beg-Balance"
            Cells(8, 6).Value2 = "Annual Payment"
            Cells(8, 9).Value2 = "Year End-Balance"

      ElseIf PymtFrqy = "Semi-Annually" Then
       VariDateIntvl = 6
            Cells(8, 4).Value2 = "Semi-Annual Periods"
            Cells(8, 5).Value2 = "Semi-Annual Beg-Balance"
            Cells(8, 6).Value2 = "Semi-Annual Payment"
            Cells(8, 9).Value2 = "Semi-Annual End-Balance"

      ElseIf PymtFrqy = "Quarterly" Then
       VariDateIntvl = 4
            Cells(8, 4).Value2 = "Quarters"
            Cells(8, 5).Value2 = "Quarter Beg-Balance"
            Cells(8, 6).Value2 = "Quarterly Payment"
            Cells(8, 9).Value2 = "Quarter End-Balance"

      ElseIf PymtFrqy = "Monthly" Then
       VariDateIntvl = 1
            Cells(8, 4).Value2 = "Month"
            Cells(8, 5).Value2 = "Month Beg-Balance"
            Cells(8, 6).Value2 = "Monthly Payment"
            Cells(8, 9).Value2 = "Month End-Balance"

    End If

    '************************************************************
    'My inputs
    '************************************************************
     balTolerance = 0.5 'Specifies desired accuracy
     iCol = 1
     pCol = 2
     outrow = 8 'sets row where data will be output to

      'finds last row of data in column 3
      LR = Worksheets("Loan Amortization").Cells(Rows.Count, 3).End(xlUp).Row

     'Clear previous data and format
     '*****************************
      'Data
      Rows(outrow + 1 & ":" & (outrow + LR + 6)).ClearContents
      'Table Borders
      Rows(outrow + 1 & ":" & (outrow + LR + 6)). _
      Borders.LineStyle = xlNone

          'Redimension the arrays
          ReDim yrBegBal(1 To IntvlLng + 1)
          ReDim ipPay(1 To IntvlLng + 1, 1 To 2)
          ReDim yrEndBal(1 To IntvlLng)

        '************************************************************
        ' Computations and output; bisection algorithm
        '************************************************************
         annualPmnt = PrcplBal * IntsRate

             'This Do loop controls the iteration
             Do While finalBal > balTolerance Or finalBal = 0

                 'Initialize balance at the beginning of year 1
                 yrBegBal(1) = PrcplBal

                'Loop to calculate and store year-by-year data
                For rNum = 1 To IntvlLng
                 ipPay(rNum, iCol) = yrBegBal(rNum) * IntsRate
                 ipPay(rNum, pCol) = annualPmnt - ipPay(rNum, iCol)
                 yrEndBal(rNum) = yrBegBal(rNum) - ipPay(rNum, pCol)

                 yrBegBal(rNum + 1) = yrEndBal(rNum)

                Next rNum

                    finalBal = yrEndBal(IntvlLng)
                    aPmtOld = annualPmnt

                    'Calculate the next annual payment to try
                    annualPmnt = annualPmnt + (finalBal * (1 + IntsRate) ^ _
                    (-IntvlLng)) / IntvlLng

                    'Count # of iterations
                    numOfIterations = numOfIterations + 1

             Loop

        'Note these calculations could be placed in an array and then _ 
        be sent to a worksheet in all at once 
        '************************************************************
        ' Output data to worksheet
        '************************************************************
        Cells(outrow + 1, 3).Value = UserDate

         For rNum = 1 To IntvlLng
            Cells(outrow + rNum + 1, 3).Value = WorksheetFunction.EDate(Cells(outrow + rNum, 3).Value, VariDateIntvl)
            Cells(outrow + rNum, 4).Value = rNum 'Year number
            Cells(outrow + rNum, 5).Value = yrBegBal(rNum)
            Cells(outrow + rNum, 6).Value = annualPmnt
            Cells(outrow + rNum, 7).Value = ipPay(rNum, iCol)
            Cells(outrow + rNum, 8).Value = ipPay(rNum, pCol)
            Cells(outrow + rNum, 9).Value = yrEndBal(rNum)
         Next rNum


        '************************************************************
        ' Format data in table
        '************************************************************
         'format as dollars
         Range(Cells(outrow + 1, 5), Cells(outrow + IntvlLng, 9)). _
         NumberFormat = "$#,##0"


         'format as dates
         Range("C9" & ":" & "C" & (IntvlLng + 8)).NumberFormat = "m/d/yy"
         Cells(outrow + IntvlLng + 1, 3).ClearContents


         'Add Borders
          Range(Cells(outrow, 3), Cells(outrow + IntvlLng, 9)).Borders.LineStyle = xlContinuous

    'Clear Variables
    IntsRate = Empty
    loanLife = Empty
    PrcplBal = Empty
    PymtFrqy = Empty
    CompFrqy = Empty
    IntvlLng = Empty
    VariDateIntvl = Empty
    UserDate = Empty

    Application.ScreenUpdating = True

End Sub