XL 2016 Classement avec VBA fond

GUERET

XLDnaute Occasionnel
Bonsoir,
Je reviens avec mon problème de classement.
Les formules me permettent de connaitre le nombre de fois où les pilotes ont fini les courses mais, seul inconvénient, comme le classement change durant la saison, la concordance pilote-place ne se fait pas et de ce fait et je me retrouve avec les résultats d'un pilote qui sont ceux d'un autre. Y a t-il une possibilité de faire concorder pilote et classement ?

D'avance, merci
https://www.cjoint.com/c/JCqvsYukAHc
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Guéret,
Dans votre formule en H5, la partie :
VB:
SOMME(Melbourne!D5=$H$3;Bahrein!D5=$H$3;Chine!D5=$H$3;Azerbaïdjan!D5=$H$3;Espagne!D5=$H$3;Monaco!D5=$H$3;Canada!D5=$H$3;France!D5=$H$3;I5)
est incorrecte. Sans préjuger des résultats, comme j'y connais rien en F1, vous pouvez faire :
Code:
(Melbourne!D5+Bahrein!D5+Chine!D5+Azerbaïdjan!D5+Espagne!D5+Monaco!D5+Canada!D5+France!D5+Autriche!D5+GB!D5+Hongrie!D5)
ce qui donne un résultat et non une erreur.

Mais est ce le résultat attendu ? Si vous vouliez le nombre de position [H3] dans l'année alors la formule est :
VB:
=SOMME(SI(Melbourne!D5=$H$3;1;0);SI(Bahrein!D5=$H$3;1;0);SI(Chine!D5=$H$3;1;0);SI(Azerbaïdjan!D5=$H$3;1;0);SI(Espagne!D5=$H$3;1;0);SI(Monaco!D5=$H$3;1;0);SI(Canada!D5=$H$3;1;0);SI(France!D5=$H$3;1;0);SI(Autriche!D5=$H$3;1;0);SI(GB!D5=$H$3;1;0);SI(Hongrie!D5=$H$3;1;0))
 
Dernière édition:

GUERET

XLDnaute Occasionnel
Bonjour et merci pour cette réponse. Mais, mon gros problème est celui de faire concorder H5 avec le nom des pilotes sachant que la VBA met à jour le classement en B et C en fonction de leurs points obtenus. Je recherche juste la formule qui me permettrait d'adapter au fur et à mesure H en fonction de B et C. Est-ce possible ??? (mon pharmacien ne veut plus me fournir en tranxène et lexomil)
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re,
En PJ un essai en passant par une fonction perso. A tester :
VB:
Function CalculPosition(Nom)
Application.Volatile
Course = Array("", "Melbourne", "Bahrein", "Chine", "Azerbaïdjan", "Espagne", _
                    "Monaco", "Canada", "France", "Autriche", "GB", "Hongrie")
NbPosOk = 0
For i = 1 To 11
    PosNom = Application.Match(Nom, Sheets(Course(i)).Range("A:A"), 0)
    If Sheets(Course(i)).Range("D" & PosNom) = [H3] Then
        NbPosOk = NbPosOk + 1
    End If
Next i
CalculPosition = NbPosOk
End Function
Par contre j'ai remis de l'ordre dans le nom des pilotes qui apparaissaient tantôt Nom Prénom, tantôt Prénom Nom.
Il faut que cette liste soit à l'identique des listes dans les différentes feuilles.
Il faut reprendre le code si on ajoute des feuilles, je l'ai limité aux pages existantes. ( peut être amélioré )

Lien :
 

GUERET

XLDnaute Occasionnel
Re,
En PJ un essai en passant par une fonction perso. A tester :
VB:
Function CalculPosition(Nom)
Application.Volatile
Course = Array("", "Melbourne", "Bahrein", "Chine", "Azerbaïdjan", "Espagne", _
                    "Monaco", "Canada", "France", "Autriche", "GB", "Hongrie")
NbPosOk = 0
For i = 1 To 11
    PosNom = Application.Match(Nom, Sheets(Course(i)).Range("A:A"), 0)
    If Sheets(Course(i)).Range("D" & PosNom) = [H3] Then
        NbPosOk = NbPosOk + 1
    End If
Next i
CalculPosition = NbPosOk
End Function
Par contre j'ai remis de l'ordre dans le nom des pilotes qui apparaissaient tantôt Nom Prénom, tantôt Prénom Nom.
Il faut que cette liste soit à l'identique des listes dans les différentes feuilles.
Il faut reprendre le code si on ajoute des feuilles, je l'ai limité aux pages existantes. ( peut être amélioré )

Lien :
 

GUERET

XLDnaute Occasionnel
Juste une question : sachant que j'ai déjà une VBA, est-il possible d'en ajouter à la suite de la précédente qui fasse un 2ème tri car, le but du jeu est de coordonner le nom des pilotes avec les pôle po comme cela est déjà fait pour le décompte des résultats ? Si oui, comment procéder ?

Cordialement
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Gueret,
Je ne pense pas que vous ayez ouvert mon fichier.
Il ne s'agit pas d'une macro mais d'une fonction perso.
Regardez en cellule H5 de la feuille Pilotes.
Si vous entrez dans cette cellule =CalculPosition(B5) il vous donne le résultat pour Hamilton puisque Hamilton est en B5.
Ensuite vous pouvez intégrer cette fonction au sein d'une macro, c'est comme vous l'entendez.
Dans l'état c'est automatique en fonction de la liste des pilotes quel que soit leur ordre d'apparition.

Cette fonction fait exactement ce qui est demandé au post #1:
Y a t-il une possibilité de faire concorder pilote et classement ?
 

GUERET

XLDnaute Occasionnel
Bonsoir,
Je viens de tester ta VBA que j'ai joint à la mienne et cela fonctionne.
Puis-je abuser de ta gentillesse en te demandant de vérifier la cohérence de mon travail et qui plus est, lorsque j'affiche en H3 autre chose que le chiffre 1 (pour connaitre de la 2ème à la 20ème place en y incluant les fois où ils sont OUT), j'obtiens ce message : " cette valeur ne correspond pas aux restrictions de validation de données". Où ai-je commis l'erreur ? Je ne suis pas très bon dans ce domaine d'où mon appel à l'aide.

Cordialement

 

GUERET

XLDnaute Occasionnel
Bonjour,
j'essaie de mettre en pratique ce que vous m'avez donné mais je ne sais comment faire pour effectuer des modifications dans la formule en H (je vois bien écrit "=CalculPosition(B5)") mais comment puis-faire pour ajouter ou soustraire d'autres courses ? En tous cas, ça marche bien.

Cordialement
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour,
Regardez le code de la fonction CalculPosition :
VB:
Function CalculPosition(Nom)
Application.Volatile
Course = Array("", "Melbourne", "Bahrein", "Chine", "Azerbaïdjan", "Espagne", _
                    "Monaco", "Canada", "France", "Autriche", "GB", "Hongrie")
NbPosOk = 0
For i = 1 To 11
    PosNom = Application.Match(Nom, Sheets(Course(i)).Range("A:A"), 0)
    If Sheets(Course(i)).Range("D" & PosNom) = [H3] Then
        NbPosOk = NbPosOk + 1
    End If
Next i
CalculPosition = NbPosOk
End Function
Le tableau Course contient toutes les feuilles qui font l'objet d'une course.
Vous pouvez en rajoutez une, en supprimer une. Il faut par contre que la structure des nouvelles feuilles soient les mêmes que celles existantes.
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Parce que d'un coté il y a LATIFI Nicholas et de l'autre LATIFI Nicolas, pour le 1er #Valeur.
Le 2eme #Valeur c'est parce OCON Sébastien est absent de la feuille Autriche.

On peut supprimer l'erreur en modifiant le code :

VB:
Function CalculPosition(Nom)
On Error GoTo Fin
Application.Volatile
Course = Array("", "Melbourne", "Bahrein", "Chine", "Azerbaïdjan", "Espagne", _
                    "Monaco", "Canada", "France", "Autriche", "GB", "Hongrie")
NbPosOk = 0
For i = 1 To 11
    a = Course(i)
    PosNom = Application.Match(Nom, Sheets(Course(i)).Range("A:A"), 0)
    If Sheets(Course(i)).Range("D" & PosNom) = [H3] Then
        NbPosOk = NbPosOk + 1
    End If
Next i
CalculPosition = NbPosOk
Fin:
End Function
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
L'ignorance c'est aussi vous avoir proposé cette solution.
Car si un coureur ne participe pas à une épreuve, cette solution l'élimine totalement.
En fait il faut faire les calculs sur toutes les feuilles où il est présent. Et ne pas tenir compte des feuilles où il est absent :
VB:
Function CalculPosition(Nom)
On Error GoTo Fin
Application.Volatile
Course = Array("", "Melbourne", "Bahrein", "Chine", "Azerbaïdjan", "Espagne", _
                    "Monaco", "Canada", "France", "Autriche", "GB", "Hongrie")
NbPosOk = 0
For i = 1 To 11
    If Not IsError(Application.Match(Nom, Sheets(Course(i)).Range("A:A"), 0)) Then
        PosNom = Application.Match(Nom, Sheets(Course(i)).Range("A:A"), 0)
        If Sheets(Course(i)).Range("D" & PosNom) = [H3] Then
            NbPosOk = NbPosOk + 1
        End If
    End If
Next i
CalculPosition = NbPosOk
Fin:
End Function
La ligne If Not IsError permet de ne traiter que les feuilles où le pilote est présent.
 

Discussions similaires

Statistiques des forums

Discussions
312 323
Messages
2 087 297
Membres
103 511
dernier inscrit
mickael.das