XL 2010 Imbriquer plusieurs select case et index/equiv

deps · 8 Janvier 2017

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

deps · 8 Janvier 2017

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

Hieu · 8 Janvier 2017

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 · 8 Janvier 2017

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 · 8 Janvier 2017

Re
salut

c'est bon pour le rang
j'avais fait la même erreur avec range et la virgule !
décidément, j'ai bien de peindre cet apres-midi, quand on revient, on a les yeux ouverts

Deps

deps · 8 Janvier 2017

Re salut

j'avais oublié de mettre le fichier .
le fichier fonctionne mais je vais tenter ta solution avec les concatenation de case pour apprendre.

merci
Deps

Hieu · 8 Janvier 2017

Et n'oublie pas de changer en résolu si c'est terminé ^^

deps · 8 Janvier 2017

OK
actuellement la solution n'est pas correcte par rapport au titre .

deps · 27 Janvier 2017

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

Hieu · 30 Janvier 2017

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.

XL 2010 Imbriquer plusieurs select case et index/equiv

deps

XLDnaute Junior

Pièces jointes

deps

XLDnaute Junior

Pièces jointes

Hieu

XLDnaute Impliqué

deps

XLDnaute Junior

deps

XLDnaute Junior

deps

XLDnaute Junior

Pièces jointes

Hieu

XLDnaute Impliqué

deps

XLDnaute Junior

deps

XLDnaute Junior

Pièces jointes

Hieu

XLDnaute Impliqué

Pièces jointes

Discussions similaires