在 VBA Access 中进行舍入的最佳方法是什么？
我目前的方法使用 Excel 方法
Excel.WorksheetFunction.Round(...
但我正在寻找一种不依赖 Excel 的方法。
Curtis Inderwiesche
问问题
32953 次
13 回答
26
请注意，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 向上舍入（对称舍入）也用于单元格格式，也用于列宽舍入（使用通用数字格式时）。“显示的精度”标志本身似乎没有进行任何舍入，它只是使用单元格格式的舍入结果。
我尝试在 VBA 中实现 Microsoft 的 SymArith 函数以进行舍入，但发现当您尝试为其提供 58.55 之类的数字时 Fix 出现错误；函数给出的结果是 58.5 而不是 58.6。然后我终于发现您可以使用 Excel Worksheet Round 函数，如下所示：
Application.Round(58.55, 1)
这将允许您在 VBA 中进行正常舍入，尽管它可能不如某些自定义函数快。我意识到这已经从问题中走出来了，但为了完整起见，我想将其包括在内。
于 2008-09-26T00:53:59.860 回答
10
要扩展已接受的答案：
“Round 函数执行从round to even，这与从round to large 不同。”
- 微软
格式总是向上取整。
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
于 2008-11-05T21:21:20.980 回答
4
在瑞士，特别是在保险业，我们必须使用几个舍入规则，这取决于它是否被淘汰、福利等。
我目前使用该功能
Function roundit(value As Double, precision As Double) As Double
roundit = Int(value / precision + 0.5) * precision
End Function
这似乎工作正常
于 2008-10-03T10:46:45.740 回答
2
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 等开始四舍五入。
于 2008-09-26T00:37:49.773 回答
2
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 倍
于 2008-10-01T00:28:21.913 回答
2
不幸的是，可以执行舍入的 VBA 的本机函数要么缺失、有限、不准确或有缺陷，而且每个函数只处理一种舍入方法。好处是它们速度很快，在某些情况下这可能很重要。
但是，精度通常是强制性的，并且以当今计算机的速度，几乎不会注意到稍微慢一点的处理，实际上对于单个值的处理来说更是如此。以下链接中的所有功能都以大约 1 µs 的速度运行。
完整的函数集——适用于所有常见的舍入方法、VBA 的所有数据类型、任何值以及不返回意外值——可以在这里找到：
或在这里：
将值向上、向下、4/5 或有效数字四舍五入 (CodePlex)
仅在 GitHub 上的代码：
它们涵盖了正常的舍入方法：
向下舍入，可选择将负值向零舍入
向上舍入，可选择将负值从零舍入
按 4/5 四舍五入，远离零或均匀（银行家四舍五入）
四舍五入到有效数字的计数
前三个函数接受所有数字数据类型，而最后一个函数存在三种类型 - 分别用于 Currency、Decimal 和 Double。
它们都接受指定的小数位数 - 包括将舍入到数十、数百等的负数。返回类型为 Variant 的那些将返回 Null 用于难以理解的输入
还包括一个用于测试和验证的测试模块。
这里有一个例子 - 用于常见的 4/5 舍入。请研究内嵌注释以了解细微的细节以及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
于 2016-05-01T11:30:01.617 回答
1
如果您谈论的是四舍五入到整数值（而不是四舍五入到n位小数），那么总是有老派的方法：
return int(var + 0.5)
（您也可以使这项工作适用于n位小数，但它开始变得有点混乱）
于 2008-09-26T01:09:37.903 回答
1
bugLance 已经在 VBA 的实现中提到了继承舍入。所以我需要一个真正的 VB6 应用程序中的舍入函数。这是我正在使用的一个。它基于我在网上找到的一个，如评论中所示。
' -----------------------------------------------------------------------------
' 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
' -----------------------------------------------------------------------------
于 2009-02-25T16:46:12.373 回答
0
VBA.Round(1.23342, 2) // will return 1.23
于 2008-09-26T00:47:39.190 回答
0
这是在 Access 2003 中始终向上舍入到下一个整数的简单方法：
BillWt = IIf([Weight]-Int([Weight])=0,[Weight],Int([Weight])+1)
例如：
- [重量] = 5.33 ; 诠释（[体重]）= 5；所以 5.33-5 = 0.33 (<>0)，所以答案是 BillWt = 5+1 = 6。
- [Weight] = 6.000, Int([Weight]) = 6 ，所以 6.000-6 = 0，所以答案是 BillWt = 6。
于 2009-12-30T16:35:06.973 回答
0
为了解决便士拆分不等于最初拆分的数量的问题，我创建了一个用户定义的函数。
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
于 2014-03-27T15:35:51.323 回答
0
我使用以下简单的函数来四舍五入我的货币，因为在我们公司我们总是四舍五入。
Function RoundUp(Number As Variant)
RoundUp = Int(-100 * Number) / -100
If Round(Number, 2) = Number Then RoundUp = Number
End Function
但这总是会四舍五入到小数点后 2 位，也可能会出错。
即使它是负数，它也会向上取整（-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
（在模块中使用，如果不明显）
于 2014-05-07T15:26:59.090 回答
0
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
于 2021-11-08T22:23:08.237 回答