1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33
| Sub tout_les_match_a_4_possibles()
Dim tabloTeam, Hommes, Femmes, H, F, i, Team1, Team2
Dim dicomatch_4
Dim puissance
Dim matchs
Hommes = Array("Frank N.", "Stephane", "Thomas", "Jochen", "Frank S.", "Bernd", "Paul", "Marcel", "Marcus", "Alexander", "Mike")
Femmes = Array("Susanne", "Isabelle", "Annaig", "Jaqueline", "Svenja", "Heide", "Sabine", "Carola", "Soazic", "Nolwenn")
Set dicomatch_4 = CreateObject("scripting.dictionary")
puissance = (UBound(Hommes) + 1) * (UBound(Femmes) + 1) 'obtention du nombre de couple possible
ReDim tabloTeam(puissance)
For H = 0 To UBound(Hommes)
For F = 0 To UBound(Femmes)
tabloTeam(i) = Hommes(H) & " / " & Femmes(F): Debug.Print "Team(" & i & ")" & Hommes(H) & " / " & Femmes(F): i = i + 1
Next
Next
For i = 1 To 10000 'ou meme 500000 tu aura le meme resultat
Team1 = tabloTeam((Rnd * (UBound(tabloTeam) - 1)))
rec:
Team2 = tabloTeam((Rnd * (UBound(tabloTeam) - 1)))
If Team2 = Team1 Then GoTo rec
If Split(Team2, "/")(1) = Split(Team1, "/")(1) Then GoTo rec 'si la femmes de la team2 = la femmes de la team on repioche
If Split(Team2, "/")(0) = Split(Team1, "/")(0) Then GoTo rec 'si l'hommes de la team2 = l'hommes de la team1 on repioche
'on a nos 4 joueurs on teste dans le dico si on l'a pas deja a l'endroit et a l'envers si on l'a pas on le garde
If Not dicomatch_4.exists(Team1 & "||" & Team2) And Not dicomatch_4.exists(Team2 & "||" & Team1) Then
dicomatch_4(Team1 & "||" & Team2) = ""
matchs = matchs + 1
Sheets("Sheet1").Cells(matchs + 1, 1) = "match (" & matchs & ")"
Sheets("Sheet1").Cells(matchs + 1, 2) = Team1
Sheets("Sheet1").Cells(matchs + 1, 3) = Team2
' Debug.Print "match (" & matchs & ")" & Team1 & " contre " & Team2
End If
Next
End Sub |
Partager