XL 2010 Imbriquer plusieurs select case et index/equiv

deps

XLDnaute Junior
Bonsoir

dans le fichier joint PERF.XLSM,
j'ai une feuille "terrain" comportant des performances (colonne F) de plusieurs équipes (dossard equipe = colonne B) .
Ces performances dépendent d'un "type d inscription" (colonne "A"), d'un N° de wod (colonne D)
=> La perf dépend de 2 Critères : Colonne A (3 choix possibles), colonne D (3 choix possibles)

je souhaiterais en cliquant sur le "bouton calcul" de la feuille "terrain"
que la macro :
- affecte la performance de l'équipe selon le bon wod dans chacune des 3 feuilles d'inscription
- calcule les rangs dans chaque wod,
- calcule les points de chaque wod par rapport au bareme (feuille bareme)
- puis le classement en colonne A selon les critères (total points/ nombre filles/age le plus petit)

je suppose qu'il faille imbriquer plusieurs select case puis utiliser index/match mais je m'y perds avec les case et if et iif.

Auriez vous une solution à me proposer ?

cordialement
Deps
 

Pièces jointes

  • PERF.xlsm
    183.9 KB · Affichages: 43

deps

XLDnaute Junior
Bonjour

Etant donné que le n° d'équipe est unique, il peut apparaitre que sur une des 3 feuilles (LF/LG/LM)
cela fait un critere en moins et j'ai contourné les "case"
j'ai ajouté dans la feuille "terrain' une colonne indwod qui permet d'éviter de chercher sur 2 criteres.
mais là encore j'ai un bug

Code:
Sub calcul()

Dim ligne&, numfeuille&

Set WF = WorksheetFunction

'dans la feuille terrain
Set dos_eq = Sheets("terrain").Range("B2:B65000")
Set wod = Sheets("terrain").Range("D2:D65000")
Set indwod = Sheets("terrain").Range("E2:E65000")
Set perfwod = Sheets("terrain").Range("G2:G65000")


On Error Resume Next

For numfeuille = 3 To 5
  'se positionner sur la feuille
   Sheets(numfeuille).Select
   ' pour chaque ligne NON VIDE DE LA COLONNE B à partir de la ligne n°5 jusque la fin non vide
   For ligne = 5 To Range("B65000").End(xlUp).Row
     ' Utiliser l'indexwod de la feuille terrain pour trouver la perf du n° d'équipe equivalent
     Range("S", ligne) = WF.Index(perfwod, WF.Match("Wod1" & Range("B", ligne), indwod, 0), 0)
     If IsEmpty(Range("S", ligne)).Value Then Range("S", ligne).Value = """"
   Next ligne

Next numfeuille

'Call calcul_rang
 
End Sub


Un forumeur aurait il une idée de ce qui manque ?

Merci
Deps
 

Pièces jointes

  • PERF.xlsm
    183.8 KB · Affichages: 39

Hieu

XLDnaute Impliqué
Salut Debs,
Pour la question initiale, il me semble que tu ne puisses pas imbriquer les select case (à confirmer ?) ; il faut concaténer les valeurs et ne faire qu'un seul select case, du style :
VB:
select case a & b & c
    case "toto" & "papa" & "lulu"
    case " toto" & papa " & "mimi"
...
End Select

J'ai corrigé ta macro :
VB:
Sub calcul()
Dim ligne&, numfeuille&

Set WF = WorksheetFunction
Set dos_eq = Sheets("terrain").Range("B2:B65000")
Set wod = Sheets("terrain").Range("D2:D65000")
Set indwod = Sheets("terrain").Range("E2:E65000")
Set perfwod = Sheets("terrain").Range("G2:G65000")

On Error Resume Next

For numfeuille = 3 To 5
Sheets(numfeuille).Select
    For ligne = 5 To Range("B65000").End(xlUp).Row
        Range("S" & ligne) = WF.Index(perfwod, WF.Match("Wod1" & Range("B" & ligne), indwod, 0), 0)
        If IsEmpty(Range("S" & ligne)) Then Range("S" & ligne).Value = """"
    Next ligne
Next numfeuille
'Call calcul_rang
End Sub

Sur la fonction Isempty, tu avais mis un .value (je pense que tu voulais le mettre sur le range, soit, à l'intérieur de la parenthèse)
La fonction Range ne demande qu'un argument (tu en avais mis deux)
 

deps

XLDnaute Junior
Bonjour

effectivement j'ai mélangé la virgule et le & entre cells(ligne,"S") et range ("S" & ligne)
merci

j'ai continué mes calculs et encore je m'arrache les cheveux
il faut que toutes les lignes soient remplies pour calculer le rang puis le point bareme.
donc j'ai recréé un for ligne /next
puis utilisé la formule rank plus exactement wf.rank
et rien ne s'affiche lors de la macro...

Qu'ai je oublié ? Est ce un problème de format de cellule?
j'ai testé avec ou sans cdbl() rien n'y fait, c'est toujours vide.

Merci encore de votre aide
Deps


Code:
Sub calcul()
Dim ligne&, numfeuille&

Set wf = WorksheetFunction
Set dos_eq = Sheets("terrain").Range("B2:B65000")
Set wod = Sheets("terrain").Range("D2:D65000")
Set indwod = Sheets("terrain").Range("E2:E65000")
Set perfwod = Sheets("terrain").Range("G2:G65000")
Set bareme = Sheets("BAreme").Range("A2:B22")

On Error Resume Next

For numfeuille = 3 To 5
Sheets(numfeuille).Select
    For ligne = 5 To Range("B65000").End(xlUp).Row
       
        Range("S" & ligne) = Format(wf.Index(perfwod, wf.Match("Wod1" & Range("B" & ligne), indwod, 0), 0, "MM:SS"))
        If IsEmpty(Range("S" & ligne)) Then Range("S" & ligne).Value = """"
               
        Range("V" & ligne) = Format(wf.Index(perfwod, wf.Match("Wod2" & Range("B" & ligne), indwod, 0), 0, "MM:SS"))
        If IsEmpty(Range("V" & ligne)) Then Range("V" & ligne).Value = """"
       
        Range("Y" & ligne) = Format(wf.Index(perfwod, wf.Match("Wod3" & Range("B" & ligne), indwod, 0), 0, "MM:SS"))
        If IsEmpty(Range("Y" & ligne)) Then Range("Y" & ligne).Value = """"
       
        Range("AB" & ligne) = Format(wf.Sum(Range("S" & ligne), Range("V" & ligne), Range("Y" & ligne)), "MM:SS")
       
    Next ligne
   
    For ligne = 5 To Range("B65000").End(xlUp).Row
       'rechercher le rang pour wod1
        ' Range("T", ligne) = wf.Rank(Range("S" & ligne), Range("S2:S65000"), 1)
         Range("T", ligne) = wf.Rank(CDbl(Range("S" & ligne)), Range("S2:S65000"), 1)

       'rechercher les points dans le bareme pour wod1
       Range("U" & ligne) = wf.VLookup(Range("U" & ligne), bareme, 2)

    Next ligne
   
Next numfeuille
'Call calcul_rang
End Sub
 

deps

XLDnaute Junior
Bonsoir
Désolé de revenir vers vous mais j'ai réutilisé mon fichier ce soir ,
et un bug persiste dans la macro "calcul"

la fonction
S5= index(terrain!g:g; equiv(b2;terrain!e:e;0);0) traduite en vba par
Range("S" & ligne) = Format(wf.Index(perfwod, wf.Match("WOD1" & Range("B" & ligne), indwod, 0), 0, "MM:SS"))

ne fonctionne plus , et met une solution vide
et à chaque fois j'ai la réponse "Error1" venant de la fonction :
If IsEmpty(Range("S" & ligne)) Then Range("S" & ligne).Value = "Error1"


Auriez vous une idée..?

merci
Deps
 

Pièces jointes

  • PERF (1).xlsm
    194.4 KB · Affichages: 32

Hieu

XLDnaute Impliqué
Salut,

Une erreur, dû à "l'emboitement" des fonctions ;
VB:
Range("S" & ligne) = Format(wf.Index(perfwod, wf.Match("WOD1" & Range("B" & ligne), indwod, 0)), "MM:SS")

Je n'ai pas corrigé la suite, mais l'erreur semble copiée.

Je te déconseille fortement de nommer tes modules identiquement aux subs et/ou fonctions.
 

Pièces jointes

  • PERF_v1.xlsm
    194.4 KB · Affichages: 33

Discussions similaires

Statistiques des forums

Discussions
314 662
Messages
2 111 640
Membres
111 242
dernier inscrit
Oyam