关于excel:MS Access的介绍

Rounding in MS Access

在VBA Access中四舍五入的最佳方法是什么?

我当前的方法使用Excel方法

1
Excel.WorksheetFunction.Round(...

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


请注意,VBA舍入函数使用Banker的舍入,将0.5舍入为偶数,如下所示:

1
2
3
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工作表功能四舍五入,但始终将.5向上四舍五入。

我已经做过一些测试,看起来像.5向上舍入(对称舍入)也用于单元格格式,也用于列宽舍入(使用"通用数字"格式时)。 \\'Precision as display \\'标志似乎没有进行任何舍入,它只是使用单元格格式的舍入结果。

我试图在VBA中从Microsoft实现SymArith函数,但是发现在尝试给它一个58.55这样的数字时,Fix出现了错误。该函数给出的结果是58.5而不是58.6。然后,我终于发现您可以使用Excel Worksheet Round函数,如下所示:

Application.Round(58.55, 1)

这将允许您在VBA中进行正常的舍入,尽管它可能不如某些自定义函数那么快。我意识到这个问题已经解决了整个问题,但是为了完整起见,我想将其包括在内。


稍微扩展一下可接受的答案:

" Round函数执行四舍五入为偶数,这与四舍五入为大数不同。"-Microsoft

格式总是四舍五入。

1
2
3
4
5
  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/zh-cn/library/se6f2zfx.aspx

如何实现自定义舍入过程:http://support.microsoft.com/kb/196652


在瑞士以及参与保险业的人,我们必须使用一些取整规则,具体取决于它是否消退,带来利益等。

我目前正在使用该功能

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

似乎工作正常


不幸的是,可以执行舍入的VBA的本机功能丢失,受限制,不准确或有错误,并且每个函数仅解决一种舍入方法。好处是它们很快,并且在某些情况下可能很重要。

但是,通常精度是强制性的,并且随着当今计算机的发展,几乎不会注意到处理速度稍慢一些,的确不是单个值的处理。下面的链接上的所有功能都以大约1?s的速度运行。

完整的功能集-适用于所有常见的舍入方法,VBA的所有数据类型,任何值,并且不返回意外值-可在以下位置找到:

将值向上,向下,向下四舍五入至有效数字(EE)

或此处:

将值向上,向下,向下四舍五入到有效数字(CodePlex)

仅在GitHub上的代码:

VBA.Round

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

  • 向下舍入,可以选择将负值向零舍入

  • 向上舍入,可以选择将负值舍入为零而不是

  • 四舍五入,从零到零(银行家的舍入)

  • 取整有效位数

前三个函数接受所有数值数据类型,而后三个函数存在三种类型-分别用于Currency,Decimal和Double。

它们都接受指定的小数位数-包括将舍入为数十,数百等的负数。以Variant为返回类型的那些将返回Null,以表示难以理解的输入

还包括一个用于测试和验证的测试模块。

这里是一个示例-常见的4/5取整。请仔细阅读在线注释,以获取微妙的细节以及使用CDec避免位错误的方式。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
' 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

1
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倍


Int和Fix都是有用的舍入函数,它们为您提供数字的整数部分。

Int总是四舍五入-Int(3.5)= 3,Int(-3.5)= -4

修正总是四舍五入-Fix(3.5)= 3,Fix(-3.5)= -3

还有强制功能,尤其是CInt和CLng,它们试图将数字强制转换为整数类型或长整型(整数介于-32,768和32,767之间,长整数介于-2,147,483,648和2,147,483,647之间)。这些都将舍入到最接近的整数,从.5的零舍入-CInt(3.5)= 4,Cint(3.49)= 3,CInt(-3.5)= -4,依此类推。


Lance已在VBA \\的实现中提到了继承舍入bug
因此,我需要在VB6应用程序中使用真正的舍入功能。
这是我正在使用的一个。它基于我在网上找到的评论中指出的内容。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
' -----------------------------------------------------------------------------
' 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
' -----------------------------------------------------------------------------

如果您正在谈论的是四舍五入为整数值(而不是四舍五入为小数点后n位),那么总有一种古老的方法:

1
return int(var + 0.5)

(您也可以将其用于n个小数位,但开始变得有点混乱)


我使用以下简单函数对货币进行四舍五入,就像在我们一直四舍五入的公司中一样。

1
2
3
4
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)

因此要提供更多舍入(或向下舍入为负数)的选项,可以使用此功能:

1
2
3
4
5
6
7
8
9
10
11
12
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

(在模块中使用,如果不太明显)


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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
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

以下是在Access 2003中始终舍入到下一个整数的简单方法:

1
BillWt = IIf([Weight]-Int([Weight])=0,[Weight],Int([Weight])+1)

例如:

  • [重量] = 5.33; Int([Weight])= 5;因此5.33-5 = 0.33(<> 0),因此答案是BillWt = 5 1 = 6。
  • [Weight] = 6.000,Int([Weight])= 6,所以6.000-6 = 0,所以答案是BillWt = 6。


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