une question pour un vrai pro d'excel

[S.O.L.O]

Multiple recherche avec condition

Bonjour,

Voila je m'occupe de la gestion de concours de boules lyonnaises , et pour vous mettre dans le contexte je vous résume les quelques règles obligatoires pour se genre de rencontre :
- Chaque équipe tire un numéro comme pour une quine ce qui lui donnera sa position dans le tableau principal du tournoi
- Quand sur le tableau, 2 équipes peuvent faire leur match, l'organisation leur donne un terrain
- Quand une équipe à gagné elle tire un nouveau numéro pour connaitre sa future position dans le tableau général et l'équipe perdante tire aussi un numéro pour connaitre sa position dans le tableau consolante
- Une équipe ne peux rejouer sur un terrain ou elle a deja jouer !!


En se qui concerne les tirages au sort , je pense etre bon , la ou je coince c'est sur l'attribution des terrains !!!!

En sujet j'ai dit que c'était pour un pro d'excel ......

en attendant vos questions .....

 

[job75]

Re : Multiple recherche avec condition

Bonsoir SOLO, bienvenue sur XLD,

(...) la ou je coince c'est sur l'attribution des terrains !!!!

On va essayer de vous décoincer pour les terrains.

Je suppose que les matchs se jouent à 2 équipes, mais comme on va le voir, on peut adapter pour d'avantage.

Les terrains on des noms (ou des numéros) et les équipes aussi (différents de ceux des terrains bien sûr)

1) Pour la programmation, on va créer une fonction macro dans un classeur Excel, à placer dans un module (Alt+F11), voici le code avec les commentaires :

Function Terrain(equipe1 As Variant, equipe2 As Variant) As Variant [COLOR="Red"]' si d'autres équipes, ajouter d'autres arguments[/COLOR]
Dim cel As Range
For Each cel In Range([A2], [A65536].End(xlUp)) [COLOR="Red"]'balayage de terrains en colonne A[/COLOR]
If Application.CountIf(cel.EntireRow, equipe1) = 0 And _
Application.CountIf(cel.EntireRow, equipe2) = 0 Then [COLOR="Red"]'si d'autres équipes, ajouter la même condition[/COLOR]
Terrain = cel [COLOR="Red"]'le 1er terrain trouvé est donc attribué[/COLOR]
Exit Function
End If
Next
Terrain = "n/a" [COLOR="Red"]'aucun terrain n'est possible[/COLOR]
End Function

2) Dans la feuille de calcul, créer un tableau :

- en colonne A, à partir de A2, entrer les noms des terrains,

- sur chaque ligne, au fur et à mesure des matchs, entrer dans les cellules les noms des équipes qui utilisent les terrains (une cellule par équipe)

3) Pour affecter un terrain, sur la 1ère ligne du tableau (ou en bas), entrer dans une cellule la formule :

=Terrain(equipe1;equipe2)

equipe1 et equipe2 étant les noms des 2 équipes, ou les références de 2 cellules contenant ces noms.

Dans la cellule apparaît le nom du 1er terrain qui n'a jamais été occupé par l'une ou l'autre des équipes.

Voilà, c'est une solution très basique. Pour info je n'ai jamais été un PRO comme vous dites, l'informatique n'ayant jamais été mon métier.

Bonne fin de soirée.

 

[S.O.L.O]

Re : une question pour un vrai pro d'excel

Bonjour, et merci d'avoir répondu aussi vite

je vais regarder ça se soir , mais je ne suis pas tres doué avec les macros, donc je risque de revenir vous embêter un peu ..

 

[eriiic]

Re : une question pour un vrai pro d'excel

Bonjour,

Si tu n'es pas très doué avec les macros comment sais-tu qu'il faut un 'pro' ?
Tu as un pro quand tu payes, ici il n'y a que des bénévoles...
eric

 

[job75]

Re : une question pour un vrai pro d'excel

Bonjour SOLO, eriiiic

Mon précédent post donnait le principe de base, voici maintenant quelques améliorations du programme (toujours dans le module) :

Public Inscrit1 As Variant, Inscrit2 As Variant 'mémorise ces variables

Function Terrain(equipe1 As Variant, equipe2 As Variant) As Variant
Dim cel As Range
[COLOR="Red"]If Application.CountIf([Equipes], equipe1) = 0 Then Terrain = equipe1 & " ??": Exit Function 'vérification de l'existence
If Application.CountIf([Equipes], equipe2) = 0 Then Terrain = equipe2 & " ??": Exit Function[/COLOR]
For Each cel In Range([A2], [A65536].End(xlUp)) 'balayage de terrains en colonne A
If Application.CountIf(cel.EntireRow, equipe1) = 0 And _
Application.CountIf(cel.EntireRow, equipe2) = 0 Then
Terrain = cel 'le 1er terrain trouvé est donc attribué
Exit Function
End If
Next
Terrain = "n/a" 'aucun terrain n'est possible
End Function

Sub Inscription()
Dim celF As Range, F$, arg$, Team1 As Variant, Team2 As Variant, celTer As Range
Set celF = Cells.Find("=Terrain(*", LookIn:=xlFormulas, LookAt:=xlWhole) 'recherche la cellule contenant la formule
If celF Is Nothing Then MsgBox "Formule d'affectation inexistante !!", 48: Exit Sub
F = celF.FormulaLocal 'texte de la formule
arg = Mid(F, InStr(F, "(") + 1, InStr(F, ")") - 1 - InStr(F, "(")) 'texte des arguments
Team1 = Evaluate(Split(arg, ";")(0)) 'récupère les équipes
Team2 = Evaluate(Split(arg, ";")(1))
If Application.CountIf([Equipes], Team1) = 0 Or _
Application.CountIf([Equipes], Team2) = 0 Or celF = "n/a" Then MsgBox celF, 48: Exit Sub
If Team1 = Inscrit1 And Team2 = Inscrit2 Then _
MsgBox "Vous venez d'inscrire ces 2 équipes, modifiez au moins l'une d'elles !", 48: Exit Sub
Set celTer = [A2:A65536].Find(celF, LookIn:=xlValues) 'cellule du terrain
Cells(celTer.Row, 256).End(xlToLeft).Offset(, 1) = Team1
Cells(celTer.Row, 256).End(xlToLeft).Offset(, 1) = Team2
Inscrit1 = Team1
Inscrit2 = Team2
End Sub

1) Pour la fonction, on s'assure que le nom des équipes existe bien (en rouge).

Pour cela constituer une liste des équipes dans une autre feuille et donner à cette liste (menu Insertion-Nom-Définir) le nom Equipes.

2) La macro Inscription inscrit automatiquement les noms des 2 équipes sur le terrain déterminé par la fonction. Je vous laisse découvrir.

Créer un bouton pour lancer la macro.

Pour éviter une double inscription si l'on appuie 2 fois de suite sur le bouton, j'utilise 2 variables Public qui mémorisent provisoirement les 2 équipes.

A+

 

[S.O.L.O]

Re : une question pour un vrai pro d'excel

je viens d'essayer et au risque de ne pas avoir fait une bonne manip ça ne fonction pas tres bien. J'ai bien le tirage des terrains mais rien devant ni dessus dessous !! lol

Si vous pouviez me faire passer un fichier exemple avec seulement 4 equipes peut etre que je comprendrai mieux .

Désolé mais deja pour moi une formule avec 3 conditions c'est compliqué alors en vba ...

merci

 

[job75]

Re : une question pour un vrai pro d'excel

Re,

Ce fichier :

 

[JCGL]

Re : une question pour un vrai pro d'excel

Bonjour à tous,
Salut Job
Salut Eric ,

Bonjour,

Si tu n'es pas très doué avec les macros comment sais-tu qu'il faut un 'pro' ?
Tu as un pro quand tu payes, ici il n'y a que des bénévoles...
eric

Plus un...

A+ à tous

 

[S.O.L.O]

Re : une question pour un vrai pro d'excel

Ah oui la je comprend mieux excellent !! je tiens à te remercier job75 d'avoir usé de ton temps pour moi .

Je repasserai surement car j'ai pas encore fini ...

encore merci

 

[job75]

Re : une question pour un vrai pro d'excel

Re, bonsoir JCGL

Je n'avais pas pensé à une chose, SOLO, c'est que probablement dans les matchs vous procédez par TOURS.

Donc il faut évidemment ajouter une condition supplémentaire : à chaque tour il ne peut pas y avoir 2 matchs sur le même terrain.

Dans la fonction j'ai donc ajouté la variable supplémentaire Tour.

Voici les macros modifiées (en rouge) :

Public Inscrit1 As Variant, Inscrit2 As Variant 'mémorise ces variables

Function Terrain([COLOR="Red"]Tour As Byte[/COLOR], equipe1 As Variant, equipe2 As Variant) As Variant
Dim cel As Range
If Application.CountIf([Equipes], equipe1) = 0 Then Terrain = equipe1 & " ??": Exit Function 'vérification de l'existence
If Application.CountIf([Equipes], equipe2) = 0 Then Terrain = equipe2 & " ??": Exit Function
For Each cel In Range([[COLOR="Red"]A3[/COLOR]], [A65536].End(xlUp)) 'balayage de terrains en colonne A
  [COLOR="Red"]If Cells(cel.Row, 2 * Tour) = "" Then[/COLOR]
    If Application.CountIf(cel.EntireRow, equipe1) = 0 And _
      Application.CountIf(cel.EntireRow, equipe2) = 0 Then
      Terrain = cel 'le 1er terrain disponible trouvé est attribué
      Exit Function
    End If
  [COLOR="Red"]End If[/COLOR]
Next
Terrain = "n/a" 'aucun terrain n'est possible
End Function

Sub Inscription()
Dim celF As Range, F$, arg$, [COLOR="Red"]Tour As Byte[/COLOR], Team1 As Variant, Team2 As Variant, celTer As Range
Set celF = Cells.Find("=Terrain(*", LookIn:=xlFormulas, LookAt:=xlWhole) 'recherche la cellule contenant la formule
If celF Is Nothing Then MsgBox "Formule d'affectation inexistante !!", 48: Exit Sub
F = celF.FormulaLocal 'texte de la formule
arg = Mid(F, InStr(F, "(") + 1, InStr(F, ")") - 1 - InStr(F, "(")) 'texte des arguments
[COLOR="Red"]Tour = Evaluate(Split(arg, ";")(0)) 'récupère le tour[/COLOR]
Team1 = Evaluate(Split(arg, ";")(1)) 'récupère les équipes
Team2 = Evaluate(Split(arg, ";")(2))
If Application.CountIf([Equipes], Team1) = 0 Or _
Application.CountIf([Equipes], Team2) = 0 Or celF = "n/a" Then MsgBox celF, 48: Exit Sub
If Team1 = Inscrit1 And Team2 = Inscrit2 Then _
MsgBox "Vous venez d'inscrire ces 2 équipes, modifiez au moins l'une d'elles !", 48: Exit Sub
Set celTer = [A2:A65536].Find(celF, LookIn:=xlValues) 'cellule du terrain
[COLOR="Red"]Cells(celTer.Row, 2 * Tour)[/COLOR] = Team1
[COLOR="Red"]Cells(celTer.Row, 2 * Tour + 1)[/COLOR] = Team2
Inscrit1 = Team1
Inscrit2 = Team2
End Sub

Fichier joint. J'y ai créé 10 équipes. Cliquez sur le bouton.

A+

 

[S.O.L.O]

Re : une question pour un vrai pro d'excel

je viens pour te le dire et tu la deja modifié !! je vais essayer d'arranger cette formule pour l'inserer dans le tableau ...

encore merci

 

[job75]

Re : une question pour un vrai pro d'excel

Re,

Encore une modif : les variables Public ne sont plus nécessaires et j'ai modifié les tests de la macro Inscription :

Function Terrain(Tour As Byte, equipe1 As Variant, equipe2 As Variant) As Variant
Dim cel As Range
If Application.CountIf([Equipes], equipe1) = 0 Then Terrain = equipe1 & " ??": Exit Function 'vérification de l'existence
If Application.CountIf([Equipes], equipe2) = 0 Then Terrain = equipe2 & " ??": Exit Function
For Each cel In Range([A3], [A65536].End(xlUp)) 'balayage de terrains en colonne A
  If Cells(cel.Row, 2 * Tour) = "" Then
    If Application.CountIf(cel.EntireRow, equipe1) = 0 And _
      Application.CountIf(cel.EntireRow, equipe2) = 0 Then
      Terrain = cel 'le 1er terrain disponible trouvé est attribué
      Exit Function
    End If
  End If
Next
Terrain = "n/a" 'aucun terrain n'est possible
End Function

Sub Inscription()
Dim celF As Range, F$, arg$, Tour As Byte, Team1 As Variant, Team2 As Variant, [COLOR="Red"]plage As Range[/COLOR], celTer As Range
Set celF = Cells.Find("=Terrain(*", LookIn:=xlFormulas, LookAt:=xlWhole) 'recherche la cellule contenant la formule
If celF Is Nothing Then MsgBox "Formule d'affectation inexistante !!", 48: Exit Sub
F = celF.FormulaLocal 'texte de la formule
arg = Mid(F, InStr(F, "(") + 1, InStr(F, ")") - 1 - InStr(F, "(")) 'texte des arguments
Tour = Evaluate(Split(arg, ";")(0)) 'récupère le tour
Team1 = Evaluate(Split(arg, ";")(1)) 'récupère les équipes
Team2 = Evaluate(Split(arg, ";")(2))
If Application.CountIf([Equipes], Team1) = 0 Or _
Application.CountIf([Equipes], Team2) = 0 Or celF = "n/a" Then MsgBox celF, 48: Exit Sub
[COLOR="Red"]Set plage = Range(Cells(3, 2 * Tour), Cells(65536, 2 * Tour + 1)) 'plage du tour
If Application.CountIf(plage, Team1) Then _
MsgBox "L'équipe " & Team1 & " est déjà inscrite pour le tour " & Tour, 48: Exit Sub
If Application.CountIf(plage, Team2) Then _
MsgBox "L'équipe " & Team2 & " est déjà inscrite pour le tour " & Tour, 48: Exit Sub[/COLOR]
Set celTer = [A2:A65536].Find(celF, LookIn:=xlValues) 'cellule du terrain
Cells(celTer.Row, 2 * Tour) = Team1
Cells(celTer.Row, 2 * Tour + 1) = Team2
End Sub

Bonne nuit.