excel - MS Access 中的舍入

Question

在 VBA Access 中进行舍入的最佳方法是什么？

我目前的方法使用 Excel 方法

Excel.WorksheetFunction.Round(...

但我正在寻找一种不依赖 Excel 的方法。

score 26 · Accepted Answer

请注意，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 中进行正常舍入，尽管它可能不如某些自定义函数快。我意识到这已经从问题中走出来了，但为了完整起见，我想将其包括在内。

score 10 · Accepted Answer

要扩展已接受的答案：

“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

score 4 · Accepted Answer

在瑞士，特别是在保险业，我们必须使用几个舍入规则，这取决于它是否被淘汰、福利等。

我目前使用该功能

Function roundit(value As Double, precision As Double) As Double
    roundit = Int(value / precision + 0.5) * precision
End Function

这似乎工作正常

score 2 · Accepted Answer

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 等开始四舍五入。

score 2 · Accepted Answer

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 倍

score 2 · Accepted Answer

不幸的是，可以执行舍入的 VBA 的本机函数要么缺失、有限、不准确或有缺陷，而且每个函数只处理一种舍入方法。好处是它们速度很快，在某些情况下这可能很重要。

但是，精度通常是强制性的，并且以当今计算机的速度，几乎不会注意到稍微慢一点的处理，实际上对于单个值的处理来说更是如此。以下链接中的所有功能都以大约 1 µs 的速度运行。

完整的函数集——适用于所有常见的舍入方法、VBA 的所有数据类型、任何值以及不返回意外值——可以在这里找到：

将值向上、向下、4/5 或有效数字 (EE) 四舍五入

或在这里：

将值向上、向下、4/5 或有效数字四舍五入 (CodePlex)

仅在 GitHub 上的代码：

VBA.圆形

它们涵盖了正常的舍入方法：

向下舍入，可选择将负值向零舍入
向上舍入，可选择将负值从零舍入
按 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

score 1 · Accepted Answer

如果您谈论的是四舍五入到整数值（而不是四舍五入到n位小数），那么总是有老派的方法：

return int(var + 0.5)

（您也可以使这项工作适用于n位小数，但它开始变得有点混乱）

score 1 · Accepted Answer

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
' -----------------------------------------------------------------------------

score 0 · Accepted Answer

0

VBA.Round(1.23342, 2) // will return 1.23

于 2008-09-26T00:47:39.190 回答

score 0 · Accepted Answer

这是在 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。

score 0 · Accepted Answer

为了解决便士拆分不等于最初拆分的数量的问题，我创建了一个用户定义的函数。

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

score 0 · Accepted Answer

我使用以下简单的函数来四舍五入我的货币，因为在我们公司我们总是四舍五入。

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

（在模块中使用，如果不明显）

score 0 · Accepted Answer

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

excel - MS Access 中的舍入

13 回答 13

Related

Reference