gpt4 book ai didi

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

转载 作者:行者123 更新时间:2023-12-04 20:56:40 24 4
gpt4 key购买 nike

我正在尝试使用 VBA 构建抵押摊销计算器.
当我在工作表中键入公式并将每个单元格引用到公式时,我的计算器就可以正常工作。它要求我将所有公式拖到贷款期限。
例如,如果贷款期限为 300 个月,我只需将公式拖到单元格编号 300 即可,它会正常工作。

问题:当我使用 VBA执行相同操作的代码我基本上遇到了一个舍入问题,在学期结束后,我没有得到 0.00 的余额。我已经尝试过正常的圆形功能和Application.WorksheetFunction.Round它仍然产生相同的结果。
为什么我的计算在工作表上有效,但是当翻译成 VBA 代码时,我得到不同的结果?
链接到我的电子表格的屏幕截图,它对应于代码:
enter image description here

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

最佳答案

工作表函数的替代方法(避免银行家四舍五入):

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

关于vba - VBA中的银行家四舍五入?,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/46320884/

24 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com