使用 VBA（债券）计算摊销成本

Question

我正在尝试为摊销成本建立一个“会计”模型。我将制作一个包含实际付款日期的数组，一个包含“摊销成本”的数组，另一个数组显示报告日的值（例如 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. 我希望数组每次迭代减少 1

请查看图片以了解我希望它的外观（绿色值是下一个数组中的“摊销成本值”，即摊销成本值）

Answer 1

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

该函数将充当 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

现在，您将需要使用数组来做任何您想做的事情，您不需要格式化单元格，您将能够多次创建您想要的任何工作表，并且代码仍然可以工作。 要创建一个数组，首先需要指定元素的数量，在这个例子中，你可以创建一个矩阵，它有 3 列从 1 到 3（如果未指定，则以数字 0 开头）和以数字 1 开头的 2 行（相同，如果不指定，0号是第一个）：

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

您也可以重新调整您的数组，但即使您使用保留也会丢失数据，您无法更改变量类型。如果大小具有来自变量的值，则需要使用 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

有了这个，你应该可以继续代码了，很抱歉没有提供更多帮助。如果您对如何做更具体的事情有任何疑问，我会尽力帮助您。

Answer 2

在我早期的 VBA 时代，我构建了一个贷款偿还计算器/调度器作为一个学习项目。该程序从Userform 获取输入参数并计算贷款还款计划。我将附上下面的文件供您查看。计算贷款支付时间表的主要算法是Bisection 算法。它与 Excel 的 Goal Seek 使用的相同。

注意：代码有点初级，因为我之前说过，我刚开始，所以我不知道我可以将参数传递给Subs而不是公开变量，我的变量命名很糟糕，等等。话虽如此，我没有时间回去让它变得健壮，但是程序被大量评论，所以我仍然认为你可以从中学习。

文件：Loan Repayment Calculator

编辑： Chandan Sengupta 的Financial Modeling Using Excel and VBA 也是一个极好的资源。我利用其中的几个想法来构建我的贷款还款计算器。

以下是计算的主要代码。请注意，以下每个变量都在用户表单中设置，但可以将它们设置为单元格： 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