Calcul automatique en Vba

Version imprimable

23/07/2010, 09h18
NEC14

Calcul automatique en Vba

Bonjour à tous,

Je vais essayé d'exposer mon problème le plus clairement possible.
J'ai un tableau Excel dans lequel les données commencent à être affichées à la ligne 4 (Titres colonnes en ligne 3).
Dans la colonne I se trouve la somme de plusieurs cellules de la même ligne (somme G+H).
Voici donc ma question :
Lorsque dans la celulle de la colonne I où se trouve le résultat est
- inférieur à 40 alors indiquer "aucun prix"
- compris entre 40 et 49.99 indiquer "Mention d'Honneur"
- compris entre 50 et 54.99 indiquer "Grand Prix régional"
- compris entre 55 et 59.99 indiquer "Premier Prix National"
- compris entre 60 et 70 indiquer "Grand Prix National"

De plus à partir de 61 et le plus près de 70 indiquer "Grand Prix d'Or"

La saisie des données se fait par un UserForm. Lorsque la ligne est complète, le résultat apparait lors du changement de ligne.

Je pourrai faire cela en formule Excel, mais c'est long et fastidieux.
Pourriez-vous m'aider à trouver une macro qui pourrait résoudre mon problème.

Je vous en remercie par avance

bonjour,

je pensais simplement résoudre cela via une fonction que tu pourrais intégrer dans tes formules .

donc juste au cas où là voici:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
Function TitrePrix(Resultat As Variant) As String
 
Select Case Fix(Resultat)
    Case Is < 40
        TitrePrix = "aucun prix"
    Case 40 To 49
        TitrePrix = "Mention d'Honneur"
    Case 50 To 54
        TitrePrix = "Grand Prix Régional"
    Case 55 To 59
        TitrePrix = "Premier Prix National"
    Case 60 To 70
        TitrePrix = "Grand Prix National"
    Case Else
        TitrePrix = "Grand prix d'Or"
End Select
 
End Function

mais j'avoue que je n'ai pas très bien compris la dernière condition....

23/07/2010, 10h27
NEC14

Bonjour mayekeul,

Tout d'abord, merci pour ta réponse.
Quant à la dernière condition de mon problème, le candidat le plus proche de 70 reçoit le prix Or. Il est peu probable que 2 candidats arrivent à la même note.

J'avez oublié, où dois-je mettre ton code ? Est-ce dans un module ?
Il y a longtemps que je n'ai pas mis vraiement le nez dans Vba alors j'ai du mal à me remettre en route.
Encore merci

oui tu met cela dans un module

et sur la cellule tu peux appeler la fonction

que voici:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
 
Function TitrePrix(Resultat As Double, ResultatsLaureats As Range) As String
'résultat est la valeur à tester
'ResultatsLaureats est l'ensemble des résultats à évaluer en vue de connaitre le grand gagnant
 
 
'résultat de base
Select Case Fix(Resultat)
    Case Is < 40
        TitrePrix = "aucun prix"
    Case 40 To 49
        TitrePrix = "Mention d'Honneur"
    Case 50 To 54
        TitrePrix = "Grand Prix Régional"
    Case 55 To 59
        TitrePrix = "Premier Prix National"
    Case 60 To 70
        TitrePrix = "Grand Prix National"
End Select
 
'est-ce le meilleur résultat?
'si oui, c'est un gaillard ce lascar!
If Application.WorksheetFunction.Max(ResultatsLaureats) = Resultat Then TitrePrix = "Grand Prix d'Or"
 
End Function

23/07/2010, 11h22
NEC14
J'ai donc mis ton code dans un module puis ce code dans ma feuille de calcul
mais un message d'erreur apparait "Argument non facultatif", et là je suis perdu. J'ai appuyé sur l'aide mais je n'ai rien compris.
Qu'est-ce qui cloche ?
Code:

1 2 3 4 Private Sub Worksheet_SelectionChange(ByVal Target As Range) TitrePrix End Sub
23/07/2010, 11h26
mayekeul

bonjour, ce que tu dois faire, c'est ceci

mettre mon code dasn un module vierge
(ça je pense que tu as fait)

ensuite dans une cellule tu peux indiquer a titre d'exemple la formule suivante

Code:

=TitrePrix(I1;I1:I100)

à noter que les deux parametres sont requis
23/07/2010, 11h32
NEC14

Merci mayekeul.
Chaque candidat selon le nombre de points acquis reçoit un prix. Donc je copie cette formule dans chaque cellule de la colonne "K" là où doit être indiqué le prix.
Ai-je bien compris ?
23/07/2010, 11h37
mayekeul
c'est bien cela

sans oublier de fixer la région d'évaluation
comme ceci
exemple pour la cellule K10:
Code:

1 2 =TitrePrix($I10;$I$1:$I$100)
et si tu travailles avec excel 2007, ce serait utile de travailler avec les tableaux
:)
23/07/2010, 11h44
NEC14

Merci beaucoup mayekeul ça fonctionne super. :ccool:

Que veux dire ta dernière ligne "utiliser les tableaux" ? J'utilise Excel 2007
23/07/2010, 12h01
mayekeul

et bien comme je le suppose tes données sont dans un tableau
tu peux formater cela dans excel
je ne connais pas l'équivalment français
mais dans la version anglaise dans le premier onglet du ruban il y a une rubrique style ou l'on trouve "format as table".
si tu connais pas, tu verras c'est cool ;)

tu aura donc une table qui se nommera "Table" et un numéro dépendant du nombre de table déjà créée.
En principe pour toi ce sera "Table1"

et dans ta colonne K tu devrais entrer une formule qui ressemblera à

Code:

=TitrePrix(Table1[[#This Row];[Resultat]];[Resultat])

c'est bien car ce sera dynamique au cas ou tu rajoutes des entrées dans la table

voilà, c'est pas très clair, mais c'est flou donc, si tu as des questions, n'hésites pas ;)
23/07/2010, 12h28
NEC14

merci beaucoup et à bientôt

Bonsoir,

Je reprends ce problème car en testant l'appli je me suis aperçu d'un soucis.
En effet, lorsqu'il s'agit de la 1ère saisie dans le tableau, j'ai systématiquement "Grand Prix d'Or" qui s'affiche, de plus cette mention ne doit s'afficher que pour les candidats ayant atteint au moins 61 points, or dans le cas présent il le met pour le candidat ayant le plus grand nombre de points.
Que dois-je modifier dans le code ?
Merci par avance
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 Function TitrePrix(Resultat As Double, ResultatsLaureats As Range) As String 'résultat est la valeur à tester 'ResultatsLaureats est l'ensemble des résultats à évaluer en vue de connaitre le grand gagnant 'résultat de base Select Case Fix(Resultat) Case Is < 40 TitrePrix = "aucun prix" Case 40 To 49 TitrePrix = "Mention d'Honneur" Case 50 To 54 TitrePrix = "Grand Prix Régional" Case 55 To 59 TitrePrix = "Premier Prix National" Case 60 To 70 TitrePrix = "Grand Prix National" End Select 'est-ce le meilleur résultat? 'si oui, c'est un gaillard ce lascar! If Application.WorksheetFunction.Max(ResultatsLaureats) = Resultat Then TitrePrix = "Grand Prix d'Or" End Function

23/07/2010, 23h10
mercatog

Code:

If Application.WorksheetFunction.Max(ResultatsLaureats) = Resultat and Resultat>60 Then TitrePrix = "Grand Prix d'Or"

peut être
24/07/2010, 10h00
NEC14

Bonjour mercatog ça marche
Bon week-end ou peut-être à plus tard