Afficher un message
Vieux 10/05/2005, 19h33   #3 (permalink)
dg62
XLDnaute Accro
 
Date d'inscription: février 2005
Localisation: Arras
Version Excel : Excel 2003 (PC)
Messages: 1 422
Envoyer un message via MSN à dg62
Par défaut Re:Imprécision/Erreur de Calcul par VBA avec ROUND

Bonsoir thierry


Le problème a du déjà posé problème à bien du monde étant donné le nombre de fonctions ecrites pour réaliser un arrondi correcte.

Code:
Function Round2(X)
' Arrondi un nombre à 2 positions décimales
' Utilise l'arrondi arithmétique
  Round2 = Int(X * 100 + 0.5) / 100
End Function

Function Round2C(X)
' Arrondi une valeur monétaire à 2 positions décimales
' Utilise l'arrondi arithmétique
  If IsNull(X) Then
    Round2C = Null
  Else
    Round2C = CCur(Int(X * 100 + 0.5) / 100)
  End If
End Function

Function Round2CB(X As Variant) As Variant
' Arrondi bancaire d'une valeur monétaire à 2 décimales.
Dim Temp As Currency, ITemp As Currency, Digit As Integer
  If IsNull(X) Then Exit Function
  Round2CB = CCur(X / 100) * 100
End Function

Function RoundN(X, N As Integer)
' Arrondi un nombre à N positions décimales
' Utilise l'arrondi arithmétique
' N doit être dans la fourchette de 0-10 pour l'obtention de résultats corrects.
Dim Facteur As Long
  Facteur = 10 ^ N
  RoundN = Int(X * Facteur + 0.5) / Facteur
End Function

Function ArrondiG(Nombre As Double, Fraction As Integer, Direction As Integer)
'Objectif: Fonction générale d'arrondi jusqu'à 9'999'999'999'999.999
'Nombre: valeur à arrondir
'Fraction: Dénominateur de la fraction utilisée pour arrondir, par exemple 100 pour arrondir à 2 décimales,
' 4 pour arrondir au 1/4, 1000 pour arrondir à 3 décimales, etc.
'Direction: 1 = arrondi au plus proche, 2 arrondi au suivant, 3 arrondi au précédent
Dim NumFrac As Double, AFrac As Double, AFrac2 As Double, NouvArrond As Double
NumFrac = Nombre - Int(Nombre)
AFrac = 1 / Fraction
NumFrac = NumFrac / AFrac
NumFrac = Int(NumFrac + 0.5)
AFrac2 = AFrac * NumFrac
NouvArrond = Int(Nombre) + AFrac2
Select Case Direction
   Case 1 'arrondi arithmétique au plus proche
      ArrondiG = NouvArrond
   Case 2 'arrondi arithmétique au suivant (plus haut)
      If NouvArrond >= Nombre Then
         ArrondiG = NouvArrond
      Else
         ArrondiG = NouvArrond + AFrac
      End If
   Case 3 'arrondi arithmétique au prédédent (plus bas)
      If NouvArrond < Nombre Then
         ArrondiG = NouvArrond
      Else
         ArrondiG = NouvArrond - AFrac
      End If
   End Select
End Function

Public Function ArrondiGlobal(ByVal Nombre As Variant, NbreDec As Long) As Double
'Objectif:  Fonction générale d'arrondi au plus proche, jusqu'à 9'999'999'999'999.999
'Arguments: Nombre = valeur à arrondir, NbreDec = nombre de décimales désirées pour le résultat

Dim dblFraction As Double, varTemp As Variant, intSgn As Integer
If Not IsNumeric(Nombre) Then
'génère une erreur indiquant que l'on a fourni un paramètre incorrect
    Err.Raise 5
End If
'Calcul de la fraction utilisée pour arrondir au nombre voulu de décimales
dblFraction = 10 ^ NbreDec
'Est-ce un nombre négatif ou positif ?
'intSgn contiendra -1, 0, ou 1
intSgn = Sgn(Nombre)
Nombre = Abs(Nombre)
'Effectue le calcul principal
varTemp = CDec(Nombre) * dblFraction + 0.5
'Termine le calcul de l'arrondi
ArrondiGlobal = intSgn * Int(varTemp) / dblFraction
End Function
Bonne soirée
__________________
@+

dg62 est déconnecté   Réponse avec citation