Как выполнить округление в MS Access, VBA

StackOverflow https://stackoverflow.com/questions/137114

Вопрос

Каков наилучший способ округления в VBA Access?

Мой текущий метод использует метод Excel

Excel.WorksheetFunction.Round(...

Но я ищу средство, которое не полагается на Excel.

Это было полезно?

Решение

Будьте осторожны, функция VBA Round использует округление Banker, где она округляет .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 Round всегда округляет значение .5 в большую сторону.

Я провел несколько тестов, и похоже, что округление .5 вверх (симметричное округление) также используется при форматировании ячеек, а также для округления ширины столбца (при использовании общего числового формата).Флаг "Точность по мере отображения", по-видимому, не выполняет никакого округления сам по себе, он просто использует округленный результат формата ячейки.

Я попытался реализовать функцию SymArith от Microsoft в VBA для моего округления, но обнаружил, что исправление выдает ошибку при попытке присвоить ему число типа 58.55;функция, дающая результат 58.5 вместо 58.6.Затем я, наконец, обнаружил, что вы можете использовать функцию округления листа Excel, например:

Заявка.Раунд (58.55, 1)

Это позволит вам выполнять обычное округление в VBA, хотя это может быть не так быстро, как некоторые пользовательские функции.Я понимаю, что этот вопрос прошел полный круг, но хотел включить его для полноты картины.

Другие советы

Чтобы немного расширить общепринятый ответ:

"Функция 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

В Швейцарии и, в частности, в страховой отрасли, мы должны использовать несколько правил округления, в зависимости от того, является ли это суммой, пособием и т.д.

В настоящее время я использую эту функцию

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

который, кажется, работает нормально

Int и Fix являются полезными функциями округления, которые дают вам целую часть числа.

Int всегда округляется в меньшую сторону - Int(3.5) = 3, Int(-3.5) = -4

Исправление всегда округляется в сторону нуля - Исправление (3.5) = 3, исправление(-3.5) = -3

Существуют также функции принуждения, в частности CInt и CLng, которые пытаются привести число к целочисленному типу или типу long (целые числа находятся в диапазоне от -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 и т.д.

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 это примерно в 40 раз быстрее, чем при использовании ExcelWorksheetFunction.Max

К сожалению, встроенные функции VBA, которые могут выполнять округление, либо отсутствуют, либо ограничены, либо неточны, либо содержат ошибки, и каждая из них адресует только один метод округления.Положительным моментом является то, что они работают быстро, и это в некоторых ситуациях может быть важно.

Однако часто точность обязательна, и при сегодняшней скорости компьютеров незначительное замедление обработки вряд ли будет замечено, особенно при обработке отдельных значений.Все функции по ссылкам ниже выполняются со скоростью около 1 мкс.

Полный набор функций - для всех распространенных методов округления, всех типов данных VBA, для любого значения и не возвращающих неожиданных значений - можно найти здесь:

Округление значений в большую, меньшую сторону, на 4/5 или до значащих цифр (EE)

или здесь:

Округление значений в большую, меньшую сторону, на 4/5 или до значащих цифр (CodePlex)

Код только на GitHub:

VBA.Круглый

Они охватывают обычные методы округления:

  • Округление в меньшую сторону с возможностью округления отрицательных значений до нуля

  • Округление в большую сторону с возможностью округления отрицательных значений от нуля

  • Округление на 4/5, либо от нуля, либо до четного (банковское округление)

  • Округление до количества значимых цифр

Первые три функции принимают все числовые типы данных, в то время как последняя существует в трех вариантах - для валюты, десятичной и двойной соответственно.

Все они принимают заданное количество десятичных дробей, включая отрицательное количество, которое округляется до десятков, сотен и т.д.Те, у кого в качестве возвращаемого типа указан 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

Если вы говорите о округлении до целого значения (а не о округлении до n десятичные знаки), всегда есть старый школьный способ:

return int(var + 0.5)

(Вы можете заставить это работать для n десятичные разряды тоже, но это начинает немного запутывать)

Лэнс уже упоминал о округлении при наследовании bug в реализации 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
' ----------------------------------------------------------------------------- 

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

Чтобы решить проблему с пенни-сплитами, которые не суммируются с суммой, из которой они были первоначально разделены, я создал определяемую пользователем функцию.

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

Я использовал следующее простой функция для округления моего валюты как и в нашей компании, мы всегда облава.

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

(используется в модуле, если это не очевидно)

Вот простой способ всегда округлять до следующего целого числа в Access 2003:

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

Например:

  • [Вес] = 5,33 ;Int([Вес]) = 5 ;итак, 5.33-5 = 0.33 (<>0), таким образом, ответ будет BillWt = 5+1 = 6.
  • [Вес] = 6.000, Int([Вес]) = 6, значит, 6.000-6 = 0, поэтому ответом будет BillWt = 6.
Лицензировано под: CC-BY-SA с атрибуция
Не связан с StackOverflow
scroll top