Comment arrondir dans MS Access, VBA

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

Question

Quelle est la meilleure façon d’arrondir dans VBA Access ?

Ma méthode actuelle utilise la méthode Excel

Excel.WorksheetFunction.Round(...

Mais je recherche un moyen qui ne repose pas sur Excel.

Était-ce utile?

La solution

Attention, la fonction Arrondi VBA utilise l'arrondi de Banker, où il arrondit .5 à un nombre pair, comme suit: 

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)

Alors que la fonction Excel Worksheet Round arrondit toujours 0,5 ".

J'ai fait quelques tests et cela ressemble à un arrondi supérieur à 5 (arrondi symétrique) est également utilisé pour le formatage des cellules, ainsi que pour l'arrondi en largeur de colonne (avec le format Général). Le drapeau "Précision telle qu’affichée" ne semble pas arrondir lui-même, il utilise simplement le résultat arrondi du format de cellule.

J'ai essayé d'implémenter la fonction SymArith de Microsoft dans VBA pour mon arrondi, mais j'ai constaté que Fix comportait une erreur lorsque vous essayez de lui attribuer un numéro tel que 58,55; la fonction donnant un résultat de 58,5 au lieu de 58,6. J'ai ensuite découvert que vous pouvez utiliser la fonction Excel Worksheet Round, comme suit:

  

Application.Round (58.55, 1)

Cela vous permettra d’arrondir normalement dans VBA, bien que cela puisse ne pas être aussi rapide que certaines fonctions personnalisées. Je me rends compte que la question est bouclée, mais je voulais l’inclure par souci de complétude.

Autres conseils

Pour développer un peu la réponse acceptée:

& "; La fonction Arrondir est arrondie à égale, ce qui diffère d'un arrondi à un autre. &";
--Microsoft

Le format est toujours arrondi. 

  Debug.Print Round(19.955, 2)
  'Answer: 19.95

  Debug.Print Format(19.955, "#.00")
  'Answer: 19.96

ACC2000: Erreurs d'arrondi lors de l'utilisation de nombres en virgule flottante: http://support.microsoft.com/ Ko / 210423

ACC2000: Comment arrondir un nombre supérieur ou inférieur d'un incrément souhaité: http://support.microsoft .com / kb / 209996

Fonction du round: http://msdn2.microsoft.com/en-us /library/se6f2zfx.aspx

Comment implémenter des procédures d'arrondi personnalisées: http://support.microsoft.com/kb/196652

En Suisse et en particulier dans le secteur des assurances, nous devons appliquer plusieurs règles d’arrondi, en fonction des avantages, des avantages, etc.

J'utilise actuellement la fonction 

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

qui semble bien fonctionner

Int et Fix sont deux fonctions d'arrondi utiles, qui vous donnent la partie entière d'un nombre.

Int arrondit toujours à l'inférieur - Int(3,5) = 3, Int(-3,5) = -4

Fix arrondit toujours vers zéro - Fix(3.5) = 3, Fix(-3.5) = -3

Il existe également des fonctions de coercition, notamment CInt et CLng, qui tentent de contraindre un nombre à un type entier ou long (les entiers sont compris entre -32 768 et 32 ​​767, les longs sont compris entre -2 147 483 648 et 2 147 483 647).Ceux-ci seront tous deux arrondis vers le nombre entier le plus proche, en partant de zéro à partir de 0,5 - CInt(3,5) = 4, Cint(3,49) = 3, CInt(-3,5) = -4, etc.

1 place = INT(number x 10 + .5)/10
3 places = INT(number x 1000 + .5)/1000

et ainsi de suite. Vous constaterez souvent que les solutions apparemment kludgy comme celle-ci sont beaucoup plus rapides que les fonctions Excel, car VBA semble fonctionner dans un espace mémoire différent.

Par exemple, If A > B Then MaxAB = A Else MaxAB = B est environ 40 fois plus rapide qu'avec ExcelWorksheetFunction.Max

Malheureusement, les fonctions natives de VBA pouvant effectuer l’arrondi sont manquantes, limitées, inexactes ou erronées, et chacune d’elles ne traite que d’une seule méthode d’arrondi. L’avantage, c’est qu’ils sont rapides et que, dans certaines situations, ils peuvent être importants.

Cependant, souvent, la précision est obligatoire et, avec la vitesse des ordinateurs actuels, un traitement un peu plus lent sera à peine perceptible, voire plus pour le traitement de valeurs uniques. Toutes les fonctions des liens ci-dessous fonctionnent à environ 1 & # 181; s.

L'ensemble complet de fonctions - pour toutes les méthodes d'arrondi courantes, tous les types de données de VBA, pour toute valeur et ne renvoyant pas de valeurs inattendues - peut être trouvé ici:

Arrondir les valeurs à la hausse, à la baisse, par 4/5 ou par des chiffres significatifs (EE)

ou ici:

Arrondir les valeurs, vers le bas, par 4/5, ou à des chiffres significatifs (CodePlex)

Code uniquement sur GitHub:

VBA.Round

Ils couvrent les méthodes d'arrondi normales:

  • Arrondir vers le bas, avec l'option permettant d'arrondir les valeurs négatives vers zéro

  • Arrondissez vers le haut, avec la possibilité d'arrondir les valeurs négatives à partir de zéro

  • Arrondissez par 4/5, soit loin de zéro, soit même jusqu'à (arrondi bancaire)

  • Arrondissez au nombre de chiffres significatifs

Les trois premières fonctions acceptent tous les types de données numériques, tandis que le dernier existe en trois variétés - respectivement pour Devise, Décimale et Double.

Ils acceptent tous un nombre spécifié de nombres décimaux, y compris un nombre négatif qui arrondira à des dizaines, des centaines, etc. Ceux avec Variant comme type de retour renverront Null pour une entrée incompréhensible.

Un module de test pour tester et valider est également inclus.

Voici un exemple - pour l’arrondi commun 4/5. Veuillez étudier les commentaires en ligne pour les détails subtils et la manière dont CDec est utilisé pour éviter les erreurs sur les bits. 

' 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

Si vous parlez d’arrondir à une valeur entière (et non d’arrondir à n décimales), il y a toujours la méthode de l'ancienne école: 

return int(var + 0.5)

(Vous pouvez également utiliser cette fonction pour n décimales, mais cela commence à être un peu brouillon)

Lance a déjà mentionné l'arrondissement hérité bug dans l'implémentation de VBA. J'ai donc besoin d'une vraie fonction d'arrondi dans une application VB6. En voici un que j'utilise. Il est basé sur celui que j'ai trouvé sur le Web, comme indiqué dans les commentaires. 

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

Pour résoudre le problème des coupures de centimes qui ne correspondaient pas au montant de la fraction d'origine, j'ai créé une fonction définie par l'utilisateur. 

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

J'ai utilisé la simple fonction suivante pour arrondir mes devises , car dans notre société, nous toujours arrondissons vers le haut. 

Function RoundUp(Number As Variant)
   RoundUp = Int(-100 * Number) / -100
   If Round(Number, 2) = Number Then RoundUp = Number
End Function

mais cela arrondira TOUJOURS à 2 décimales et peut également provoquer une erreur.

même s'il est négatif, il sera arrondi (-1.011 sera -1,01 et 1.011 sera 1,02)

afin de fournir davantage d'options pour arrondir (ou baisser pour négatif), vous pouvez utiliser cette fonction: 

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

(utilisé dans un module, si ce n'est pas évident)

Voici un moyen facile de toujours arrondir au prochain nombre entier dans Access 2003: 

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

Par exemple:

  • [Poids] = 5,33; Int ([Poids]) = 5; donc 5.33-5 = 0.33 (< > 0), donc la réponse est BillWt = 5 + 1 = 6.
  • [Poids] = 6.000, Int ([Poids]) = 6, donc 6.000-6 = 0, donc la réponse est BillWt = 6.
Licencié sous: CC-BY-SA avec attribution
Non affilié à StackOverflow
scroll top