Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Microsoft 365 Code VBA

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

  • VBA_FORUM.xlsm
    18.8 KB · Affichages: 5

Deadpool_CC

XLDnaute Accro
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
            ....
 

Deadpool_CC

XLDnaute Accro
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+
 

jebibo

XLDnaute Occasionnel
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.




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

  • VBA_FORUM.xlsm
    22.6 KB · Affichages: 0
Dernière édition:

Discussions similaires

Réponses
10
Affichages
686
Réponses
14
Affichages
1 K
Réponses
10
Affichages
359
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…