vba - VBA中的银行家四舍五入？

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

始终使用“选项显式”来检查您的声明。
如果使用 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