在 VBA Access 中舍入的最佳方法是什么？
我目前的方法使用 Excel 方法
Excel.WorksheetFunction.Round(...
但我正在寻找一种不依赖 Excel 的方法。
【问题讨论】：
标签： excel vba ms-access rounding worksheet-function
Public Function RoundUpDown(value, decimals, updown)
If IsNumeric(value) Then
rValue = Round(value, decimals)
rDec = 10 ^ (-(decimals))
rDif = rValue - value
If updown = "down" Then 'rounding for "down" explicitly.
If rDif > 0 Then ' if the difference is more than 0, it rounded up.
RoundUpDown = rValue - rDec
ElseIf rDif < 0 Then ' if the difference is less than 0, it rounded down.
RoundUpDown = rValue
Else
RoundUpDown = rValue
End If
Else 'rounding for anything thats not "down"
If rDif > 0 Then ' if the difference is more than 0, it rounded up.
RoundUpDown = rValue
ElseIf rDif < 0 Then ' if the difference is less than 0, it rounded down.
RoundUpDown = rValue + rDec
Else
RoundUpDown = rValue
End If
End If
End If
'RoundUpDown(value, decimals, updown) 'where updown is "down" if down. else rounds up. put this in your program.
End Function
【讨论】：
这是在 Access 2003 中始终向上舍入到下一个整数的简单方法：
BillWt = IIf([Weight]-Int([Weight])=0,[Weight],Int([Weight])+1)
例如：
【讨论】：
BillWt = -Int(-[Weight]).
不幸的是，可以执行舍入的 VBA 的本机函数要么缺失、受限、不准确或有问题，而且每个函数只处理一种舍入方法。好处是它们速度很快，在某些情况下这可能很重要。
但是，精度通常是强制性的，并且以当今计算机的速度，几乎不会注意到稍微慢一点的处理，尤其是对于单个值的处理。以下链接中的所有函数的运行时间约为 1 µs。
完整的函数集 - 适用于所有常见的舍入方法、VBA 的所有数据类型、适用于任何值以及不返回意外值 - 可在此处找到：
Rounding values up, down, by 4/5, or to significant figures (EE)
或这里：
Rounding values up, down, by 4/5, or to significant figures (CodePlex)
代码仅在 GitHub：
它们涵盖了正常的舍入方法：
向下舍入，可选择将负值向零舍入
四舍五入，可选择将负值从零舍入
四舍五入，从零或偶数（银行家四舍五入）
四舍五入到有效数字计数
前三个函数接受所有数字数据类型，而最后一个函数存在三种类型 - 分别用于 Currency、Decimal 和 Double。
它们都接受指定的小数位数 - 包括将舍入到数十、数百等的负数。返回类型为 Variant 的那些将返回 Null 用于难以理解的输入
还包括一个用于测试和验证的测试模块。
这里有一个示例 - 用于常见的 4/5 舍入。请研究嵌入式 cmets 以了解细微的细节以及使用 CDec 来避免位错误的方式。
' Common constants.
'
Public Const Base10 As Double = 10
' Rounds Value by 4/5 with count of decimals as specified with parameter NumDigitsAfterDecimals.
'
' Rounds to integer if NumDigitsAfterDecimals is zero.
'
' Rounds correctly Value until max/min value limited by a Scaling of 10
' raised to the power of (the number of decimals).
'
' Uses CDec() for correcting bit errors of reals.
'
' Execution time is about 1µs.
'
Public Function RoundMid( _
ByVal Value As Variant, _
Optional ByVal NumDigitsAfterDecimals As Long, _
Optional ByVal MidwayRoundingToEven As Boolean) _
As Variant
Dim Scaling As Variant
Dim Half As Variant
Dim ScaledValue As Variant
Dim ReturnValue As Variant
' Only round if Value is numeric and ReturnValue can be different from zero.
If Not IsNumeric(Value) Then
' Nothing to do.
ReturnValue = Null
ElseIf Value = 0 Then
' Nothing to round.
' Return Value as is.
ReturnValue = Value
Else
Scaling = CDec(Base10 ^ NumDigitsAfterDecimals)
If Scaling = 0 Then
' A very large value for Digits has minimized scaling.
' Return Value as is.
ReturnValue = Value
ElseIf MidwayRoundingToEven Then
' Banker's rounding.
If Scaling = 1 Then
ReturnValue = Round(Value)
Else
' First try with conversion to Decimal to avoid bit errors for some reals like 32.675.
' Very large values for NumDigitsAfterDecimals can cause an out-of-range error
' when dividing.
On Error Resume Next
ScaledValue = Round(CDec(Value) * Scaling)
ReturnValue = ScaledValue / Scaling
If Err.Number <> 0 Then
' Decimal overflow.
' Round Value without conversion to Decimal.
ReturnValue = Round(Value * Scaling) / Scaling
End If
End If
Else
' Standard 4/5 rounding.
' Very large values for NumDigitsAfterDecimals can cause an out-of-range error
' when dividing.
On Error Resume Next
Half = CDec(0.5)
If Value > 0 Then
ScaledValue = Int(CDec(Value) * Scaling + Half)
Else
ScaledValue = -Int(-CDec(Value) * Scaling + Half)
End If
ReturnValue = ScaledValue / Scaling
If Err.Number <> 0 Then
' Decimal overflow.
' Round Value without conversion to Decimal.
Half = CDbl(0.5)
If Value > 0 Then
ScaledValue = Int(Value * Scaling + Half)
Else
ScaledValue = -Int(-Value * Scaling + Half)
End If
ReturnValue = ScaledValue / Scaling
End If
End If
If Err.Number <> 0 Then
' Rounding failed because values are near one of the boundaries of type Double.
' Return value as is.
ReturnValue = Value
End If
End If
RoundMid = ReturnValue
End Function
【讨论】：
我使用以下简单函数来四舍五入我的货币，因为我们公司总是四舍五入。
Function RoundUp(Number As Variant)
RoundUp = Int(-100 * Number) / -100
If Round(Number, 2) = Number Then RoundUp = Number
End Function
但这总是会四舍五入到小数点后两位，也可能会出错。
即使它是负数，它也会四舍五入（-1.011 为 -1.01，1.011 为 1.02）
所以要为向上取整（或向下取整）提供更多选项，您可以使用此函数：
Function RoundUp(Number As Variant, Optional RoundDownIfNegative As Boolean = False)
On Error GoTo err
If Number = 0 Then
err:
RoundUp = 0
ElseIf RoundDownIfNegative And Number < 0 Then
RoundUp = -1 * Int(-100 * (-1 * Number)) / -100
Else
RoundUp = Int(-100 * Number) / -100
End If
If Round(Number, 2) = Number Then RoundUp = Number
End Function
（在模块中使用，如果不明显）
【讨论】：
为了解决一分钱分割加起来不等于最初分割金额的问题，我创建了一个用户定义的函数。
Function PennySplitR(amount As Double, Optional splitRange As Variant, Optional index As Integer = 0, Optional n As Integer = 0, Optional flip As Boolean = False) As Double
' This Excel function takes either a range or an index to calculate how to "evenly" split up dollar amounts
' when each split amount must be in pennies. The amounts might vary by a penny but the total of all the
' splits will add up to the input amount.
' Splits a dollar amount up either over a range or by index
' Example for passing a range: set range $I$18:$K$21 to =PennySplitR($E$15,$I$18:$K$21) where $E$15 is the amount and $I$18:$K$21 is the range
' it is intended that the element calling this function will be in the range
' or to use an index and total items instead of a range: =PennySplitR($E$15,,index,N)
' The flip argument is to swap rows and columns in calculating the index for the element in the range.
' Thanks to: http://stackoverflow.com/questions/5559279/excel-cell-from-which-a-function-is-called for the application.caller.row hint.
Dim evenSplit As Double, spCols As Integer, spRows As Integer
If (index = 0 Or n = 0) Then
spRows = splitRange.Rows.count
spCols = splitRange.Columns.count
n = spCols * spRows
If (flip = False) Then
index = (Application.Caller.Row - splitRange.Cells.Row) * spCols + Application.Caller.Column - splitRange.Cells.Column + 1
Else
index = (Application.Caller.Column - splitRange.Cells.Column) * spRows + Application.Caller.Row - splitRange.Cells.Row + 1
End If
End If
If (n < 1) Then
PennySplitR = 0
Return
Else
evenSplit = amount / n
If (index = 1) Then
PennySplitR = Round(evenSplit, 2)
Else
PennySplitR = Round(evenSplit * index, 2) - Round(evenSplit * (index - 1), 2)
End If
End If
End Function
【讨论】：
小心，VBA Round 函数使用 Banker 的四舍五入，它将 0.5 舍入为偶数，如下所示：
Round (12.55, 1) would return 12.6 (rounds up)
Round (12.65, 1) would return 12.6 (rounds down)
Round (12.75, 1) would return 12.8 (rounds up)
而 Excel 工作表函数舍入，总是向上舍入 0.5。
我已经进行了一些测试，看起来 0.5 向上舍入（对称舍入）也用于单元格格式设置，也用于列宽舍入（使用通用数字格式时）。 'Precision as shown' 标志本身似乎没有进行任何舍入，它只是使用单元格格式的舍入结果。
我尝试在 VBA 中实现 Microsoft 的 SymArith 函数以进行舍入，但是当您尝试给它一个像 58.55 这样的数字时，发现 Fix 有错误；函数给出的结果是 58.5 而不是 58.6。然后我终于发现你可以使用 Excel Worksheet Round 函数，如下所示：
Application.Round(58.55, 1)
这将允许您在 VBA 中进行正常舍入，尽管它可能不如某些自定义函数快。我意识到这已经从问题中走出来了，但为了完整起见，我想将其包括在内。
【讨论】：
Lance 已经在 VBA 的实现中提到了继承舍入 bug。
所以我需要一个真正的 VB6 应用程序中的舍入函数。
这是我正在使用的一个。它基于我在网络上找到的，如 cmets 所示。
' -----------------------------------------------------------------------------
' RoundPenny
'
' Description:
' rounds currency amount to nearest penny
'
' Arguments:
' strCurrency - string representation of currency value
'
' Dependencies:
'
' Notes:
' based on RoundNear found here:
' http://advisor.com/doc/08884
'
' History:
' 04/14/2005 - WSR : created
'
Function RoundPenny(ByVal strCurrency As String) As Currency
Dim mnyDollars As Variant
Dim decCents As Variant
Dim decRight As Variant
Dim lngDecPos As Long
1 On Error GoTo RoundPenny_Error
' find decimal point
2 lngDecPos = InStr(1, strCurrency, ".")
' if there is a decimal point
3 If lngDecPos > 0 Then
' take everything before decimal as dollars
4 mnyDollars = CCur(Mid(strCurrency, 1, lngDecPos - 1))
' get amount after decimal point and multiply by 100 so cents is before decimal point
5 decRight = CDec(CDec(Mid(strCurrency, lngDecPos)) / 0.01)
' get cents by getting integer portion
6 decCents = Int(decRight)
' get leftover
7 decRight = CDec(decRight - decCents)
' if leftover is equal to or above round threshold
8 If decRight >= 0.5 Then
9 RoundPenny = mnyDollars + ((decCents + 1) * 0.01)
' if leftover is less than round threshold
10 Else
11 RoundPenny = mnyDollars + (decCents * 0.01)
12 End If
' if there is no decimal point
13 Else
' return it
14 RoundPenny = CCur(strCurrency)
15 End If
16 Exit Function
RoundPenny_Error:
17 Select Case Err.Number
Case 6
18 Err.Raise vbObjectError + 334, c_strComponent & ".RoundPenny", "Number '" & strCurrency & "' is too big to represent as a currency value."
19 Case Else
20 DisplayError c_strComponent, "RoundPenny"
21 End Select
End Function
' -----------------------------------------------------------------------------
【讨论】：
稍微扩展一下已接受的答案：
“Round 函数执行从round to even，这与round to large不同。”
--Microsoft
格式总是向上取整。
Debug.Print Round(19.955, 2)
'Answer: 19.95
Debug.Print Format(19.955, "#.00")
'Answer: 19.96
ACC2000：使用浮点数时的舍入错误：http://support.microsoft.com/kb/210423
ACC2000：如何将数字向上或向下舍入所需的增量：http://support.microsoft.com/kb/209996
圆函数：http://msdn2.microsoft.com/en-us/library/se6f2zfx.aspx
如何实现自定义舍入过程：http://support.microsoft.com/kb/196652
【讨论】：
在瑞士，特别是在保险业，我们必须使用几个舍入规则，具体取决于是否淘汰、福利等。
我目前正在使用该功能
Function roundit(value As Double, precision As Double) As Double
roundit = Int(value / precision + 0.5) * precision
End Function
这似乎工作正常
【讨论】：
1 place = INT(number x 10 + .5)/10
3 places = INT(number x 1000 + .5)/1000
等等。你会经常发现像这样明显笨拙的解决方案比使用 Excel 函数快得多，因为 VBA 似乎在不同的内存空间中运行。
例如If A > B Then MaxAB = A Else MaxAB = B 比使用 ExcelWorksheetFunction.Max 快大约 40 倍
【讨论】：
如果您谈论的是四舍五入到整数值（而不是四舍五入到 n 个小数位），那么总是有老派的方法：
return int(var + 0.5)
（你也可以对 n 个小数位进行这项工作，但它开始有点乱）
【讨论】：
VBA.Round(1.23342, 2) // will return 1.23
【讨论】：
Int 和 Fix 都是有用的舍入函数，它们为您提供数字的整数部分。
Int 总是向下取整 - Int(3.5) = 3, Int(-3.5) = -4
Fix 总是向零舍入 - Fix(3.5) = 3, Fix(-3.5) = -3
还有强制函数，特别是 CInt 和 CLng，它们试图将数字强制转换为整数类型或长类型（整数介于 -32,768 和 32,767 之间，长整数介于 -2,147,483,648 和 2,147,483,647 之间）。这些都将向最接近的整数四舍五入，从 0.5 - CInt(3.5) = 4、Cint(3.49) = 3、CInt(-3.5) = -4 等开始四舍五入。
【讨论】：