Arrondir valeur

cs_matth72
Messages postés
71
Date d'inscription
jeudi 21 février 2008
Statut
Membre
Dernière intervention
8 décembre 2011
- 28 mai 2008 à 15:30
cs_yvesyves
Messages postés
561
Date d'inscription
samedi 10 janvier 2004
Statut
Membre
Dernière intervention
11 octobre 2010
- 30 mai 2008 à 13:18
Bonjour à tous
J'ai un tout petit problème je récupère une valeur d'un calcul par exemple 2,38 je voudrai arrondir la valeur à 2,5
J'ai essayé de convertir les valeurs avec CSng ou encore CInt mais en vain
Si une âme charitable peut m?aider merci d'avance

13 réponses

cs_yvesyves
Messages postés
561
Date d'inscription
samedi 10 janvier 2004
Statut
Membre
Dernière intervention
11 octobre 2010

28 mai 2008 à 16:02
Tu n'as qu'à creer une fonction :

Private Sub Form_Load()
MsgBox (ArrondiPerso(2.38))
End Sub


Public Function ArrondiPerso(Number As Double) As Single
Dim MonDecimale As Double
MonDecimale = CDbl(Number - Int(Number))
Dim Resultat As Single
Select Case MonDecimale
Case Is > 0.75
Resultat = Int(Number) + 1
Case Is > 0.5
Resultat = Int(Number) + 0.75
Case Is > 0.25
Resultat = Int(Number) + 0.5
Case Is > 0
Resultat = Int(Number) + 0.25
End Select
ArrondiPerso = Resultat
End Function


 
0
mortalino
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
28 mai 2008 à 16:03
Salut,

je ne sais pas si c'est la meilleure façon de procéder, mais je t'en propose une (ça m'aura occupé quelques minutes )

Option Explicit

Private Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCTYPE As Long, ByVal lpLCData As String, ByVal cchData As Long) As
Long
Private Declare Function GetUserDefaultLCID Lib "kernel32" () As Long

Enum eMode
    Inferior = 0
    Superior = 1
    Half = 2
End Enum

Private Const LOCALE_SDECIMAL = &HE

Public Property Get DecimalSeparator() As
String
    Dim nLength As Long
    Dim nLocale As Long
    
nLocale = GetUserDefaultLCID()
nLength = GetLocaleInfo(nLocale, LOCALE_SDECIMAL, vbNullString,
0) - 1
DecimalSeparator = Space$(nLength)
GetLocaleInfo nLocale, LOCALE_SDECIMAL, DecimalSeparator,
nLength
End Property

Function RoundNumber(ByVal dValue As Double, Mode As eMode) As
Double
    Dim vartemp As Integer
    
    
If InStr(1, CStr(dValue), DecimalSeparator) Then
    Select Case Mode
        Case Inferior
            RoundNumber = CDbl(Mid$(dValue, 1,
InStr(1, dValue,
DecimalSeparator)))
        Case Superior
            RoundNumber = CDbl(Mid$(dValue, 1,
InStr(1, dValue, DecimalSeparator))) +
1
        Case Half
            vartemp = CInt(Right$(Round(dValue, 1), 1))
            If vartemp < 3 Then
                RoundNumber = CDbl(Mid$(dValue, 1,
InStr(1, dValue,
DecimalSeparator)))
            ElseIf vartemp > 7 Then
                RoundNumber = CDbl(Mid$(dValue, 1,
InStr(1, dValue, DecimalSeparator))) +
1
            Else
                RoundNumber = CDbl(Mid$(dValue, 1,
InStr(1, dValue, DecimalSeparator))) +
0.5
            End If
    End Select
Else
    RoundNumber = dValue
End If
End Function

Sub test()
    Debug.Print RoundNumber(2, Inferior)
    Debug.Print RoundNumber(2, Superior)
    Debug.Print RoundNumber(2, Half)
    
    Debug.Print RoundNumber(2.3, Inferior)
    Debug.Print RoundNumber(2.3, Superior)
    Debug.Print RoundNumber(2.3, Half)
    
    Debug.Print RoundNumber(2.8, Inferior)
    Debug.Print RoundNumber(2.8, Superior)
    Debug.Print RoundNumber(2.8, Half)
End Sub
~
<small>[code.aspx?ID=39466 Mortalino] ~
Colorisation automatique</small>

@++

le mystérieux chevalier,"Provençal, le gaulois"
Forum Office & VBA
0
cs_yvesyves
Messages postés
561
Date d'inscription
samedi 10 janvier 2004
Statut
Membre
Dernière intervention
11 octobre 2010

28 mai 2008 à 16:04
Ca arrondit la valeur a 0.25 près
0
mortalino
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
28 mai 2008 à 16:05
Arf..

bah voilà, je me suis fait ch**r pour rien, surtout avec mes Mid..
Bien vu le code, c'est une façon à laquelle je n'avais pas pensé

@++

le mystérieux chevalier,"Provençal, le gaulois"
Forum Office & VBA
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
cs_yvesyves
Messages postés
561
Date d'inscription
samedi 10 janvier 2004
Statut
Membre
Dernière intervention
11 octobre 2010

28 mai 2008 à 16:55
Salut Mortalino,
Désolé :S. J'ai une petite question. Pourrais tu m'expliquer ce qu'est GetLocalInfo, par curiosité. Merci à toi
 
0
cs_matth72
Messages postés
71
Date d'inscription
jeudi 21 février 2008
Statut
Membre
Dernière intervention
8 décembre 2011

28 mai 2008 à 17:21
merci de ta reponse sa fonction mais pas comme je voudrais
vu que je suis pressé sa fera l'affaire
encore merci
a+
0
cs_matth72
Messages postés
71
Date d'inscription
jeudi 21 février 2008
Statut
Membre
Dernière intervention
8 décembre 2011

28 mai 2008 à 17:27
desoler j'avais pas vu qu'il y avait tand de reponse en tout cas merci des infos a++
0
jmfmarques
Messages postés
7668
Date d'inscription
samedi 5 novembre 2005
Statut
Membre
Dernière intervention
22 août 2014
27
28 mai 2008 à 19:34
Bonjour,


est-ce ce que tu souhaites ?N

Private Sub Command1_Click()
 Dim toto As Double
 toto = 1.22
 toto = Int(toto) + IIf((toto - Int(toto)) >= 0.25, 0.5, 0)
 MsgBox toto
End Sub


 
0
cs_matth72
Messages postés
71
Date d'inscription
jeudi 21 février 2008
Statut
Membre
Dernière intervention
8 décembre 2011

29 mai 2008 à 08:56
merci je vais travailler dessus
a+
0
mortalino
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
29 mai 2008 à 17:05
salut YvesYves

En fait je ne manipule cet API le mystérieux chevalier,"Provençal, le gaulois"
Forum Office & VBA
0
cs_yvesyves
Messages postés
561
Date d'inscription
samedi 10 janvier 2004
Statut
Membre
Dernière intervention
11 octobre 2010

29 mai 2008 à 17:17
Ok Merci
 
0
mortalino
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
29 mai 2008 à 17:20
voici l'exemple d'API-guide

Option Explicit

Const LOCALE_USER_DEFAULT = &H400
Const LOCALE_SENGCOUNTRY = &H1002 ' English name of
country
Const LOCALE_SENGLANGUAGE = &H1001  ' English name of
language
Const LOCALE_SNATIVELANGNAME = &H4  ' native name of
language
Const LOCALE_SNATIVECTRYNAME = &H8  ' native name of
country
Private Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As
Long
Private Sub Form_Load()
    'KPD-Team
2001
    'URL:
http://www.allapi.net/
    'E-Mail:
KPDTeam@Allapi.net
    MsgBox "You live in " & GetInfo(LOCALE_SENGCOUNTRY) & " (" & GetInfo(LOCALE_SNATIVECTRYNAME) & ")," & vbCrLf & "and you speak " & GetInfo(LOCALE_SENGLANGUAGE) & " (" & GetInfo(LOCALE_SNATIVELANGNAME) & ").", vbInformation
End Sub
Public Function GetInfo(ByVal lInfo As Long) As String
    Dim Buffer As String, Ret As String
    Buffer = String$(256, 0)
    Ret = GetLocaleInfo(LOCALE_USER_DEFAULT, lInfo, Buffer,
Len(Buffer))
    If Ret > 0 Then
        GetInfo = Left$(Buffer, Ret - 1)
    Else
        GetInfo = ""
    End If
End Function
~
<small>[code.aspx?ID=39466 Mortalino] ~
Colorisation automatique</small>

@++

le mystérieux chevalier,"Provençal, le gaulois"
Forum Office & VBA
0
cs_yvesyves
Messages postés
561
Date d'inscription
samedi 10 janvier 2004
Statut
Membre
Dernière intervention
11 octobre 2010

30 mai 2008 à 13:18
Ok je vois merci beaucoup.
0