Microsoft 365 Code VBA

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

jebibo

XLDnaute Occasionnel
Bonjour Forum,

Je sollicite votre aide pour m’aider à finaliser mon code VBA.

J’ai une table concernant une règle d’arrondissement de prix. Elle se retrouve dans le fichier en p.j. j’ai le code VBA à coté que j’essaie de modifier en fonction de cette règle d’arrondissement.

J’y suis presque mais j’ai besoin d’aide.



Merci pour votre support.

Au plaisir
 

Pièces jointes

Bonjour,

quand je vois tes 'Case' je me dis que des valeurs peuvent correspondre à plusieurs cas ... t'es sur du comportement du Select dans ces cas là ?
valeur de 0.28 quel case il va prendre : case is <0.3 ; Case is <04.99 ; Case is <9.99

Pour éviter tout flou
- sur les extrême tu gardes le "case is < 0.3"
- mais sur les autres passe en " case X to Y" ..; exemple " Case 0.301 TO 4.99 "

et en plus je vois que tu n'as pas pris exactement les mêmes conditions que tu as mis dans ton algorithme en 'français'
Case is < 0.30 ... ce n'est pas Case Is <= 0.30 (

Bref modifie tes cases et dis nous s'il y a du mieux 🙂
Et fais attention à tes bornes pour être certains de ne pas laisser de trou : j'ai mis volontairement un 0.301 pour cela

VB:
    Select Case Valeur
        Case Is <= 0.3
            Ch_Rd = .Round(Valeur, 2)
        Case 0.301 To 4.99
            Ch_Rd = .RoundDown(Valeur, 1) + 0.08
            ....
 
Re,
Ce que je veux dire c'est que tu utilise mal les "Case" ...
Commence par lire cela pour utiliser Les Bons termes pour les conditions de tes "Case"
Après je manque de temps pour corriger partout dans ton code et tester ... Fait déjà les Modifications pour utiliser correctement le Select Case et ensuite reviens vers nous si cela ne fonctionne toujours pas.

A+
 
Bonjour DeadPool_CC

voici mon code, j'ai des problèmes dans la section <.30
et >180$ j'ai appliqué tes conseilles mais je suis bloqué pour l'instant.
Merci pour tout
Voila mon code et je joint le fichier.

1670613761751.png



Function Ch_Rd#(ByVal Valeur#)
With Application.WorksheetFunction
Select Case Valeur
Case Is <= 0.3
Ch_Rd = .Round(Valeur, 2)
Case 0.301 To 4.99
Ch_Rd = Valeur - .RoundDown(Valeur, 0)
Select Case Ch_Rd
Case Is < 0.38
Ch_Rd = 0.38 + .RoundDown(Valeur, 0)
Case Else
Ch_Rd = .RoundDown(Valeur, 1) + 0.08
End Select
Case 5# To 9.99
Ch_Rd = Valeur - .RoundDown(Valeur, 0)
Select Case Ch_Rd
Case Is < 0.29
Ch_Rd = 0.28 + .RoundDown(Valeur, 0)
Case Is < 0.49
Ch_Rd = 0.48 + .RoundDown(Valeur, 0)
Case Is < 0.79
Ch_Rd = 0.78 + .RoundDown(Valeur, 0)
Case Else
Ch_Rd = 0.98 + .RoundDown(Valeur, 0)
End Select
Case 10# To 39.99
Ch_Rd = Valeur - .RoundDown(Valeur, 0)
Select Case Ch_Rd
Case Is < 0.49
Ch_Rd = 0.48 + .RoundDown(Valeur, 0)
Case Else
Ch_Rd = 0.98 + .RoundDown(Valeur, 0)
End Select
Case 40# To 179.99
Ch_Rd = (Valeur / 10) - .RoundDown(Valeur / 10, 0)
Select Case Ch_Rd
Case Is < 0.3
Ch_Rd = (.RoundDown(Valeur / 10, 0) + 0.298) * 10
Case Is < 0.5
Ch_Rd = (.RoundDown(Valeur / 10, 0) + 0.498) * 10
Case Is < 0.8
Ch_Rd = (.RoundDown(Valeur / 10, 0) + 0.798) * 10
Case Else
Ch_Rd = (.RoundDown(Valeur / 10, 0) + 0.998) * 10
End Select
Case Is < 180#
Ch_Rd = (Valeur / 10) - .RoundDown(Valeur / 10, 0)
Select Case Ch_Rd
Case Is < 0.3
Ch_Rd = (.RoundDown(Valeur / 10, 0) + 0.298) * 10
Case Is < 0.5
Ch_Rd = (.RoundDown(Valeur / 10, 0) + 0.498) * 10
Case Is < 0.8
Ch_Rd = (.RoundDown(Valeur / 10, 0) + 0.798) * 10
Case Else
Ch_Rd = (.RoundDown(Valeur / 10, 0) + 0.998) * 10
End Select
Case Else
Ch_Rd = (Valeur / 10) - .RoundDown(Valeur / 10, 0)
Select Case Ch_Rd
Case Is < 0.5
Ch_Rd = (.RoundDown(Valeur / 10, 0) + 0.498) * 10
Case Else
Ch_Rd = (.RoundDown(Valeur / 10, 0) + 0.998) * 10
End Select
End Select
End With
End Function
 

Pièces jointes

Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
10
Affichages
397
Réponses
10
Affichages
738
Réponses
8
Affichages
495
Retour