Question

我正在尝试使用VBA建立抵押摊销计算器。当我在工作表中键入公式并将每个单元格引用到公式时，我的计算器工作正常。它要求我将所有公式拖到贷款期限。例如，如果贷款持续时间是300个月，我可以拖动公式来说单元号300，它将正常工作。

问题：当我使用VBA代码执行相同操作时，我基本上会遇到一个舍入问题，在该术语结束后，我得不到0.00的余额。我已经尝试了正常的舍入函数和Application.WorksheetFunction.Round，它仍然产生相同的结果。为什么我的计算工作在工作表上但是当翻译成VBA代码时我会得到不同的结果？链接到我的电子表格的屏幕截图，该屏幕截图对应于代码：

Option Explicit

Sub Loan2()

Dim i As Integer, LD As Integer
LD = Range("C5").Value
Range("B11", "G1000").ClearContents
Range("B11", "G1000").Interior.ColorIndex = xlNone
For i = 1 To LD
    Cells(10 + i, 2).Value = i 'Payment Period
    Cells(10 + i, 3) = Application.WorksheetFunction.Round(Range("C7").Value, 2) 'Monthly Payment
    Cells(10 + i, 5) = Application.WorksheetFunction.Round(Cells(10 + i - 1, 6) * (Range("C4").Value / 12), 2) 'Interest payment
    Cells(10 + i, 4) = Application.WorksheetFunction.Round(Cells(10 + i, 3).Value - Cells(10 + i, 5).Value, 2) 'Principle payment
    Cells(10 + i, 6).Value = Cells(10 + i - 1, 6).Value - Cells(10 + i, 4).Value 'Balance
    Cells(10 + i, 7) = Cells(10 + i, 4).Value + Cells(10 + i, 5).Value 'Sum of principle and interest.
Next i

End Sub

Answer 1

工作表功能的替代方案（避免银行家舍入）：

Function roundIt(ByVal d As Double, ByVal nDigits As Integer) As Double
' Purpose: avoid so called bankers' rounding in VBA (5 always rounds even)
If nDigits > 0 Then
   ' if european colon instead of point separartor
   ' roundIt= val(Replace(Format(d, "0." & String(nDigits, "0")), ",", "."))
     roundIt= val(Format(d, "0." & String(nDigits, "0")))
Else
   ' if european colon instead of point separartor
   ' roundIt =  val(Replace(Format(d / (10 ^ nDigits), "0."), ",", "."))
   roundIt = val(Format(d / (10 ^ nDigits), "0."))
End If
End Function

始终使用“Option explicit”来检查您的声明。如果使用Type结构，代码会更易读。将此内容写入模块的声明头。

Option Explicit

Type TLoan
   Interest       As Double
   LD             As Integer
   Principal      As Double
   Annuity        As Double
End Type

以下是您添加了一些内容的代码

Sub Loan2()
Dim loan As TLoan                                   ' declare loan as of type TLoan
Dim i As Integer                                    ' no more use for LD ", LD As Integer"
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("MySheetName")     ' fully qualified range

With loan
  .Interest = ws.Range("C4").Value
  .LD = ws.Range("C5").Value
  .Principal = ws.Range("C6").Value
  .Annuity = ws.Range("C7").Value
End With

With ws
  .Range("B10").Value = 0
  .Range("F10").Value = loan.Principal              ' principal
  .Range("B11", "G1000").ClearContents
  .Range("B11", "G1000").Interior.ColorIndex = xlNone

  For i = 1 To loan.LD
    .Cells(10 + i, 2).Value = i                     'Payment Period
    .Cells(10 + i, 3) = roundIt(loan.Annuity, 2)   'Monthly Payment
    .Cells(10 + i, 5) = roundIt(.Cells(10 + i - 1, 6) * (loan.Interest / 12), 2) 'Interest payment
    .Cells(10 + i, 4) = roundIt(.Cells(10 + i, 3).Value - .Cells(10 + i, 5).Value, 2) 'Principle payment
    .Cells(10 + i, 6).Value = Cells(10 + i - 1, 6).Value - .Cells(10 + i, 4).Value    'Balance
    .Cells(10 + i, 7) = .Cells(10 + i, 4).Value + .Cells(10 + i, 5).Value             'Sum of principle and interest.
  Next i
End With
End Sub

附加提示（自动填充例程）

如果要包含公式而不是纯值，请尝试使用“Excel-VBA-自动填充公式为Excel VBA: AutoFill Multiple Cells with Formulas的多个单元格”中显示的自动填充例程。

注意：此代码指的是不同范围的另一个问题！试着玩吧。

Sub FillDown()

Dim strFormulas(1 To 3) As Variant

With ThisWorkbook.Sheets("Formeln")
    strFormulas(1) = "=SUM(A2:B2)"
    strFormulas(2) = "=PRODUCT(A2:B2)"
    strFormulas(3) = "=A2/B2"
'    Pattern Formulas
    .Range("C2:E2").Formula = strFormulas
'    AutoFill Target
    .Range("C2:E11").FillDown
End With

End Sub

银行家在VBA中进行四舍五入？

1 个答案: