Rounding in MS Access

后端 未结 12 715
夕颜
夕颜 2020-11-28 14:23

Whats the best way to round in VBA Access?

My current method utilizes the Excel method

Excel.WorksheetFunction.Round(...

But I am l

12条回答
  •  天命终不由人
    2020-11-28 15:13

    Lance already mentioned the inherit rounding bug in VBA's implementation. So I need a real rounding function in a VB6 app. Here is one that I'm using. It is based on one I found on the web as is indicated in the comments.

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

提交回复
热议问题