Comment arrondir dans MS Access, VBA
-
02-07-2019 - |
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.
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:
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.