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