Autres Tirage au sort pour concours de pétanque.

[Fcarroué]

Bonjour aux experts d'Excel et aux autres.
J'ai réalisé un tableau de concours de pétanque qui calcule et classe les équipes, d'environ 16 voire plus.
Je cherche à réaliser un tirage automatique, mais mes connaissances en formule sur Excel ont leurs limites.
Y a-t-il quelqu'un dans la communauté pour m'aider à réaliser ce genre de chose ?

Je vous remercie par avance.

 

[bsalv]

juste pour savoir si je me trompe pas nulle part,
57 joueurs, 11 terrains, 15 jeux

 

[Dranreb]

Il y a 35 rencontres en double mais pas de partenariats en double.
Remarque: je l'ai établi avec ce code :

Option Explicit
Sub Vérif()
   Dim NbPart() As Integer, NbRenc() As Integer, TDon(), L&, C&, X&, TSpl1$(), TSpl2$(), P1%, P2%, TRésu(), TJA()
   TDon = [Tabel2].Value
   ReDim NbPart(0 To VersusJA(57, 56)), NbRenc(0 To VersusJA(57, 56))
   For L = 1 To UBound(TDon, 1): For C = 2 To UBound(TDon, 2)
      TSpl1 = Split(TDon(L, C), " vs ")
      TSpl2 = Split(TSpl1(1), "-")
      TSpl1 = Split(TSpl1(0), "-")
      For P1 = 1 To UBound(TSpl1): X = VersusJA(TSpl1(0), TSpl1(P1)): NbPart(X) = NbPart(X) + 1: Next P1
      For P2 = 1 To UBound(TSpl2): X = VersusJA(TSpl2(0), TSpl2(P2)): NbPart(X) = NbPart(X) + 1: Next P2
      For P1 = 0 To UBound(TSpl1): For P2 = 0 To UBound(TSpl2)
         X = VersusJA(TSpl1(P1), TSpl2(P2)): NbRenc(X) = NbRenc(X) + 1
         Next P2, P1, C, L
   ReDim TRésu(1 To UBound(NbPart) + 1, 1 To 4)
   For L = 1 To UBound(TRésu, 1)
      TJA = JAVersus(L - 1)
      TRésu(L, 1) = TJA(0)
      TRésu(L, 2) = TJA(1)
      TRésu(L, 3) = NbPart(L - 1)
      TRésu(L, 4) = NbRenc(L - 1)
      Next L
      [C15].Resize(UBound(TRésu, 1), 4).Value = TRésu
   End Sub
Public Function VersusJA(ByVal J As Long, ByVal A As Long) As Long
   Dim Echg As Long
   If J > A Then Echg = A: A = J: J = Echg
   If A > J Then VersusJA = A * (A - 3) \ 2 + J Else VersusJA = -1
   If VersusJA < 0 Then Err.Raise 9999, , "VersusJA(" & J & ", " & A & ") impossible."
   End Function
Public Function JAVersus(ByVal VS As Long)
   Dim J As Long, A As Long
   A = Int(Sqr(2 * VS + 0.25) + 1.5)
   J = VS - A * (A - 3) \ 2
   JAVersus = Array(J, A)
   End Function

 

[bsalv]

avec 57 joueurs, 11 terrains et 20 jeux, ce sont 275 en double, c'est preque inevitable
12 jeux sans doublons est possible.