Sub Tirage()
Dim NP(21) As Byte
'NP tableau des nombres premiers utiles
Dim T(250) As String
' nbj nombre de joueurs
' ecart : nombre de joueurs divisé par 3
' nbe : nombre d'équipes
' nbmanche : nb de manches
' nat : numéro à tirer
' ntp : Numéro tirage précédent
' nbppm ; nombre de parties par manche
' cnpremier : choix du nombre premier
' nps : nombre premier sélectionné
' rang : rang dans le tableau des noms
' i indice de boucle
' j tirage aléatoire
' l indice de ligne dans la liste
Randomize
NP(1) = 3: NP(2) = 5: NP(3) = 7: NP(4) = 11: NP(5) = 13: NP(6) = 17: NP(7) = 19: NP(8) = 23: NP(9) = 29: NP(10) = 31: NP(11) = 37
NP(12) = 41: NP(13) = 43: NP(14) = 47: NP(15) = 53: NP(16) = 59: NP(17) = 61
NP(18) = 67: NP(19) = 71: NP(20) = 73: NP(21) = 79
Nettoyage
Worksheets("Liste").Select
nbj = Range("A252").Value
If nbj Mod 4 <> 0 Then
MsgBox ("Tirage impossible. Le nombre de joueurs n'est pas un multiple de 4")
GoTo err
End If
'Modification tableau des nombres premiers en fonction du nombre de joueurs
If nbj = 8 Then
NP(1) = 1: NP(2) = 3: NP(3) = 13: NP(4) = 31
End If
If nbj = 24 Then
NP(1) = 1: NP(2) = 5: NP(3) = 23: NP(4) = 31
End If
'Il faut vider le tableau des essais précédents
For i = 1 To nbj
T(i) = ""
Next i
'Il faut construire le tableau des inscrits de façon aléatoire
l = 1: cnpremier = 0
For i = 1 To nbj
l = l + 1
j = Int(nbj * Rnd(nbj)) + 1:
If T(j) <> "" Then
Do
j = j + 1
If j = nbj + 1 Then j = 1
Loop Until T(j) = ""
End If
T(j) = Cells(l, 1).Value & " " & Left(Cells(l, 2).Value, 3)
Next i
'Affichage du tableau dans l'onglet Liste Colonne I
Worksheets("Recap").Select
For i = 1 To nbj
Cells(i + 2, 2).Value = T(i)
Next i
nbManche = 0
Do
nbManche = InputBox("Nombre de manches 3,4,5", "Tirage du nombre de manches")
Loop Until nbManche >= 3
If (nbManche < 3) Or (nbManche = "") Then Exit Sub
'Initialisation
cnpremier = 0
nbppm = nbj / 4
ecart = 2 * nbppm
For i = 1 To nbManche
feuille = "Manche" & i
'MsgBox (Feuille)
Worksheets(feuille).Select
ActiveSheet.Unprotect
cnpremier = cnpremier + 1
nps = NP(cnpremier)
Do
If (nbj Mod nps = 0) Then
cnp = cnp + 1
nps = NP(cnp)
End If
Loop Until (nbj Mod nps) <> 0
For li = 1 To nbppm
If i = 1 Then
For co = 1 To 4
Cells(li + 3, co).Value = T((li - 1) * 4 + co)
Next co
Else
For co = 1 To 4
If (li = 1) And (co = 1) Then
Cells(li + 3, co).Value = T(1)
ntp = 1
End If
If li * co <> 1 Then
nat = (ntp + nps) Mod nbj
If nat = 0 Then nat = nbj
Cells(li + 3, co).Value = T(nat)
ntp = nat
End If
Next co
End If
Next li
'Dernière manche - cas particulier
If i = 5 Then
rang = 1
For k = 1 To nbj / 2
co = k Mod 4
If co = 0 Then co = 4
If Int(k / 4) = k / 4 Then li = k / 4 Else li = Int(k / 4) + 1
Cells(li + 3, co).Value = T(rang)
rang = rang + 2
Next k
rang = 2
For k = nbj / 2 + 1 To nbj
co = k Mod 4
If co = 0 Then co = 4
If Int(k / 4) = k / 4 Then li = k / 4 Else li = Int(k / 4) + 1
Cells(li + 3, co).Value = T(rang)
rang = rang + 2
Next k
End If
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Next i
Exit Sub
err:
MsgBox ("Erreur")
End Sub
J'aimerai donc que à place que la macro me renvoie une fenêtre erreur car il n'a pas un nombre d'équipe qui correspond à un multiple de 4. Cela me mette 6 personnes dans les cellules H6:H11