Algorythme et VBA

**MARGAR** · 24/08/2012, 11h13

Bonjour le forum,

Comment mettre de l'ordre dans les résultats d'un tri éffectué avec un algorythme.

Merci d'avance de votre aide

Cordialement

Margar

Ci-joint petit progr. pour explication approfondie

**Bear the french** · 24/08/2012, 12h08

Bonjour MARGAR,

Cela fait plaisir de voir du code bien indenté et bien commenté.

Je ne me suis pas plongé dedans mais je t'ai fait un bout de code pour déterminer le nombre de doublettes et de triplettes :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub nbdedoublettetriplette()
Dim nbdedoublette, nbdetriplette, nbtotalinscrits As Integer
 
nbtotalinscrits = InputBox("Nombre total d'inscrits ?")
 
Select Case nbtotalinscrits Mod 3
    Case 0
        nbdetriplette = Int(nbtotalinscrits / 3)
        nbdedoublette = 0
    Case 1
        nbdetriplette = Int(nbtotalinscrits / 3) - 1
        nbdedoublette = 2
    Case 2
        nbdetriplette = Int(nbtotalinscrits / 3)
        nbdedoublette = 1
End Select
 
MsgBox "Pour " & nbtotalinscrits & " inscrits, il y aura " & nbdetriplette & " équipe(s) de triplette et " & nbdedoublette & " équipe(s) de doublette"
 
End Sub

Bertrand

**MARGAR** · 24/08/2012, 12h30

Salut Bertand,

Désolé mais ton code ne fonctionne pas avec le programme

Cordialement

Marcel

**Bear the french** · 24/08/2012, 14h08

Bien sûr qu'il faut l'adapter à ton contexte - mais je t'assure que la macro fonctionne à merveille.

Dans ton code tu indiques :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Nb_Equipes = Range("F29")

Donc le nombre d'équipe n'est pas calculé par Excel mais tu l'as préalablement saisi en cellule F29...

Il faut procéder par ordre :

1. Saisir les inscriptions avec catégorie
2. En fonction des inscriptions, calculer le nombre d'équipe et pour chaque équipe savoir s'il s'agit d'une doublette ou d'une triplette
3. Effectuer le tirage au sort
4. Déterminer le nombre de tour
5. Ordonner les résultats

J'ai l'impression que tu veux commencer par la fin.

Donc, commences par mettre en forme un tableau d'inscription (avec Nom/Prénom/Catégorie) puis par individu et grâce à mon code, on pourra savoir de quel équipe il fait parti et si cette équipe est une doublette ou une triplette.

Procèdes par étape, c'est plus simple.

Bertrand

**evx136** · 24/08/2012, 14h09

Bonjour si ça peut vous aider à avancer, j'avais fait un bout de code pour un tournoi d'Echec.
Dispo en PJ
cordialement

**MARGAR** · 24/08/2012, 14h47

@ Bear the french,

ok, je vais faire de mon mieux.

Merci d'avance

@ evx136,
bien gentil de ta proposition mais cela ne me convient pas.

Merci et bonne journée

**Bear the french** · 24/08/2012, 17h00

Bon, on y va étape par étape.

Déjà une question, sur le tableau ci dessous, je ne trouve pas de résultat pour 7 joueurs :

Pour l'amorce, j'ai fait un fichier qui met à jour automatiquement le nombre de joueurs inscrits, le nombre de triplettes, le nombre de doublettes et donc le nombre total d'équipes. A tester avec des noms bidons et me dire si le début convient.

Je ne sais pas s'il faut un tableau par catégorie (un tableau pour les licenciés, pour les femmes, pour les enfants par exemple)... On va dire que les inscrits dans mon tableau sont tous de la même catégorie et sont donc tous susceptibles de se rencontrer.

Le début du code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Option Explicit
Dim nbdedoublette, nbdetriplette, nbtotalinscrits As Integer
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
'déclenchement de la macro si changement sur les cellules concernées
If Not Intersect(Target, Range("B4:C65000")) Is Nothing Then
    ' met à jours le nombre de noms inscrits
    Range("I1").Value = [B65536].End(xlUp).Row - 5
End If
 
' initialisation des variables
nbtotalinscrits = Range("I1").Value
nbdetriplette = 0
nbdedoublette = 0
 
' algorythme qui détermine le nombre de doublette et triplette
If nbtotalinscrits > 3 Then
    nbdetriplette = Sheets("Equipe").Range("B" & nbtotalinscrits - 2).Value
    nbdedoublette = Sheets("Equipe").Range("C" & nbtotalinscrits - 2).Value
End If
 
' transcriptions des résultats sur la feuille
Range("F1").Value = nbdetriplette + nbdedoublette
Range("F2").Value = nbdetriplette
Range("F3").Value = nbdedoublette
 
End Sub

Bertrand

Version 1-1 = chaque joueur se voit affecter dans une doublette ou une triplette - et l'équipe à un numéro qui lui est affecté.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
Option Explicit
Dim nbdedoublette, nbdetriplette, nbtotalinscrits As Integer
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, x, y, numequipe As Integer
 
'déclenchement de la macro si changement sur les cellules concernées
If Not Intersect(Target, Range("B4:C65000")) Is Nothing Then
    ' met à jours le nombre de noms inscrits
    Range("I1").Value = [B65536].End(xlUp).Row - 5
End If
 
' initialisation des variables
nbtotalinscrits = Range("I1").Value
nbdetriplette = 0
nbdedoublette = 0
 
' algorythme qui détermine le nombre de doublette et triplette
If nbtotalinscrits > 3 Then
    nbdetriplette = Sheets("Equipe").Range("B" & nbtotalinscrits - 2).Value
    nbdedoublette = Sheets("Equipe").Range("C" & nbtotalinscrits - 2).Value
End If
 
' transcriptions des résultats sur la feuille
Range("F1").Value = nbdetriplette + nbdedoublette
Range("F2").Value = nbdetriplette
Range("F3").Value = nbdedoublette
 
' initialisation des variables
Range("E6:F59").ClearContents
x = nbdetriplette * 3
y = nbdedoublette * 2
numequipe = 0
 
' affecte le numéro d'équipe et le type d'équipe
For i = 6 To 6 + nbtotalinscrits
    If x <> 0 Then
        If x Mod 3 = 0 Then
            numequipe = numequipe + 1
        End If
        Range("E" & i).Value = numequipe
        Range("F" & i).Value = "Triplette"
        x = x - 1
    Else
        If y <> 0 Then
            If y Mod 2 = 0 Then
                numequipe = numequipe + 1
            End If
            Range("E" & i).Value = numequipe
            Range("F" & i).Value = "Doublette"
            y = y - 1
        End If
    End If
Next i
 
End Sub

Bertrand

**MARGAR** · 24/08/2012, 17h57

En ce qui concerne ta question sur le tableau :

Cela ne fonctionne pas avec 7 joueurs car cela n'est pas possible de créer d'équipes de Triplettes et/ou de Doublettes. C'est le seul cas qui n'est pas possible.

Pour ce qui est des Noms et Prénoms chez nous, on les répertorie comme ceci, par ex. on attribue un N° à chaques Prénoms et on ne prend pas en compte les Noms. On les encode via une liste déroulante.

Ex : 001 LEON
002 JEANINE
003 MARC
004 MICHEL
005 RITA

**Bear the french** · 24/08/2012, 19h18

Ok, je tiens compte de ta remarque.

Version 1-2 : correctif --> 7 joueurs pas de solution, apparition d'un tableau avec les équipes constituées sous la forme "Equipe n°X : 001 LEON + 002 PIERRE + 003 PATRICE"

Etape suivante : tirage au sort des rencontres.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
Option Explicit
Dim nbdedoublette, nbdetriplette, nbtotalinscrits As Integer
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, x, y, numequipe As Integer
Dim texteequipe As String
 
If Target.Count > 1 Then Exit Sub
 
'déclenchement de la macro si changement sur les cellules concernées
If Not Intersect(Target, Sheets("Inscription").Range("B4:C59")) Is Nothing Then
    ' met à jours le nombre de noms inscrits
    Application.EnableEvents = False
    Sheets("Inscription").Range("I1").Value = [B60].End(xlUp).Row - 5
 
    ' initialisation des variables
    nbtotalinscrits = Sheets("Inscription").Range("I1").Value
    nbdetriplette = 0
    nbdedoublette = 0
 
    ' algorythme qui détermine le nombre de doublette et triplette
    If nbtotalinscrits > 3 Then
        nbdetriplette = Sheets("Equipe").Range("B" & nbtotalinscrits + 1).Value
        nbdedoublette = Sheets("Equipe").Range("C" & nbtotalinscrits + 1).Value
    End If
 
    ' transcriptions des résultats sur la feuille
    Sheets("Inscription").Range("F1").Value = nbdetriplette + nbdedoublette
    Sheets("Inscription").Range("F2").Value = nbdetriplette
    Sheets("Inscription").Range("F3").Value = nbdedoublette
 
    ' initialisation des variables
    Sheets("Inscription").Range("E6:F59").ClearContents
    x = nbdetriplette * 3
    y = nbdedoublette * 2
    numequipe = 0
 
    ' affecte le numéro d'équipe et le type d'équipe
    For i = 6 To 6 + nbtotalinscrits
        If x <> 0 Then
            If x Mod 3 = 0 Then
                numequipe = numequipe + 1
            End If
            Sheets("Inscription").Range("E" & i).Value = numequipe
            Sheets("Inscription").Range("F" & i).Value = "Triplette"
            x = x - 1
        Else
            If y <> 0 Then
                If y Mod 2 = 0 Then
                    numequipe = numequipe + 1
                End If
                Sheets("Inscription").Range("E" & i).Value = numequipe
                Sheets("Inscription").Range("F" & i).Value = "Doublette"
                y = y - 1
            End If
        End If
    Next i
 
    ' initialisation des variables
    Sheets("Inscription").Range("H6:J23").ClearContents
    x = nbdetriplette * 3
    y = nbdedoublette * 2
    numequipe = 0
 
    ' rempli la liste d'équipe et le type d'équipe
    For i = 6 To [E60].End(xlUp).Row
        If Sheets("Inscription").Range("E" & i).Value <> Sheets("Inscription").Range("E" & i - 1).Value Then
            texteequipe = Sheets("Inscription").Range("A" & i).Value & " " & Sheets("Inscription").Range("C" & i).Value
            Sheets("Inscription").Range("H" & Sheets("Inscription").Range("E" & i).Value + 5).Value = "Equipe n°" & Sheets("Inscription").Range("E" & i).Value & " : " & texteequipe
        Else
            texteequipe = texteequipe & " + " & Sheets("Inscription").Range("A" & i).Value & " " & Sheets("Inscription").Range("C" & i).Value
            Sheets("Inscription").Range("H" & Sheets("Inscription").Range("E" & i).Value + 5).Value = "Equipe n°" & Sheets("Inscription").Range("E" & i).Value & " : " & texteequipe
        End If
    Next i
    Application.EnableEvents = True
End If
 
End Sub

Bertrand

**MARGAR** · 24/08/2012, 19h56

Ok pour la suppression des N° d'équipes.

Je te joins un petit fichier pour y voir un peu plus !

Je viens de faire un essai pour te l'envoyer, mais, même Zippé (586 Ko), il ne le prend pas !!!

Je peux peut-être te l'envoyer via un e-mail ?

Marcel

**Bear the french** · 24/08/2012, 20h05

Deux solutions :

1. Utiliser dl.free.fr (je ne sais pas si les administrateurs l'autorisent - donc adresses moi le lien généré par MP)
2. Atteindre 10 pouces levés je crois pour te permettre de joindre un fichier... Mais la première solution parait plus rapide

Bertrand

Nouvelle version - v1-3 : sans les numéros d'équipe qui sont masqués et nouvelle présentation

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
Option Explicit
Dim nbdedoublette, nbdetriplette, nbtotalinscrits As Integer
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, x, y, numequipe As Integer
Dim texteequipe As String
 
If Target.Count > 1 Then Exit Sub
 
'déclenchement de la macro si changement sur les cellules concernées
If Not Intersect(Target, Sheets("Inscription").Range("B4:C59")) Is Nothing Then
 
    Application.EnableEvents = False
 
    ' initialisation des variables
    nbtotalinscrits = [B60].End(xlUp).Row - 5 ' met à jours le nombre de noms inscrits
    nbdetriplette = 0
    nbdedoublette = 0
 
    ' algorythme qui détermine le nombre de doublette et triplette
    If nbtotalinscrits > 3 Then
        nbdetriplette = Sheets("Equipe").Range("B" & nbtotalinscrits + 1).Value
        nbdedoublette = Sheets("Equipe").Range("C" & nbtotalinscrits + 1).Value
    End If
 
    ' transcriptions des résultats sur la feuille
    Sheets("Inscription").Range("F1").Value = nbdetriplette + nbdedoublette
    Sheets("Inscription").Range("F2").Value = nbdetriplette
    Sheets("Inscription").Range("F3").Value = nbdedoublette
    Sheets("Inscription").Range("J6").Value = nbtotalinscrits
 
    ' initialisation des variables
    Sheets("Inscription").Range("E6:F59").ClearContents
    x = nbdetriplette * 3
    y = nbdedoublette * 2
    numequipe = 0
 
    ' affecte le numéro d'équipe et le type d'équipe
    For i = 6 To 6 + nbtotalinscrits
        If x <> 0 Then
            If x Mod 3 = 0 Then
                numequipe = numequipe + 1
            End If
            Sheets("Inscription").Range("E" & i).Value = numequipe
            Sheets("Inscription").Range("F" & i).Value = "Triplette"
            x = x - 1
        Else
            If y <> 0 Then
                If y Mod 2 = 0 Then
                    numequipe = numequipe + 1
                End If
                Sheets("Inscription").Range("E" & i).Value = numequipe
                Sheets("Inscription").Range("F" & i).Value = "Doublette"
                y = y - 1
            End If
        End If
    Next i
 
    ' initialisation des variables
    Sheets("Inscription").Range("H15:J32").ClearContents
    x = nbdetriplette * 3
    y = nbdedoublette * 2
    numequipe = 0
 
    ' rempli la liste d'équipe et le type d'équipe
    For i = 6 To [E60].End(xlUp).Row
        If Sheets("Inscription").Range("E" & i).Value <> Sheets("Inscription").Range("E" & i - 1).Value Then
            Sheets("Inscription").Range("H" & Sheets("Inscription").Range("E" & i).Value + 14).Value = CStr("Equipe = " & Sheets("Inscription").Range("A" & i).Value & " " & Sheets("Inscription").Range("C" & i).Value)
        Else
            Sheets("Inscription").Range("H" & Sheets("Inscription").Range("E" & i).Value + 14).Value = Sheets("Inscription").Range("H" & Sheets("Inscription").Range("E" & i).Value + 14).Value & " + " & Sheets("Inscription").Range("A" & i).Value & " " & Sheets("Inscription").Range("C" & i).Value
        End If
    Next i
    Application.EnableEvents = True
End If
 
 
End Sub

**MARGAR** · 24/08/2012, 20h31

Bertrand,

voici le lien concernant mon fichier : http://dl.free.fr/rWF57i7vx

Marcel

**Bear the french** · 24/08/2012, 21h08

Bon il nous faut analyser ton algorithme de tirage aléatoire (au passage j'ai fait un peu de ménage) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
Sub TirageV2()
 
Dim Tablo, temp
Dim I As Integer, J As Long, k As Integer, L As Byte
Dim NbJ As Integer
Dim Nb3 As Long
Dim Nb2 As Long
Dim Num As Long
Dim Cl As Integer
Dim NbManche As Byte
Dim Alea  As Integer
Dim Cel As Range
Dim Plage As Range
 
With Sheets("Liste")
    Tablo = .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)
End With
NbJ = UBound(Tablo)
 
With Sheets("Recap")
    .Range("B3:B100").ClearContents
    For I = 1 To NbJ
      .Cells(I + 2, 2) = Tablo(I, 1)
    Next I
End With
 
Select Case NbJ Mod 3                      ' Reste entier sur la division NbJ/3
    Case 0
      If (NbJ / 3) Mod 2 > 0 Then            ' Nombre équipe impair
        Nb3 = (NbJ / 3) - 2
        Nb2 = 3
      Else
        Nb3 = NbJ / 3
        Nb2 = 0
      End If
    Case 1
      If ((NbJ \ 3) - 1) Mod 2 = 0 Then      ' 1 équipe de 3 en moins = nombre pair
        Nb3 = (NbJ \ 3) - 1
        Nb2 = 2
      Else
        Nb3 = (NbJ \ 3) - 3
        Nb2 = 5
      End If
    Case 2
      If (NbJ \ 3) Mod 2 = 0 Then             ' Nombre équipe de 3 pair
        Nb3 = (NbJ \ 3) - 2
        Nb2 = 4
      Else
        Nb3 = (NbJ \ 3)
        Nb2 = 1
      End If
End Select
 
' On efface tous les tableaux
For L = 1 To 5
    Sheets("P" & L).Range("A4:H12,I4:I12").ClearContents
Next L
 
Randomize
 
ReDim Preserve Tablo(1 To UBound(Tablo, 1), 1 To UBound(Tablo, 2) + 1)
 
If UserForm1.OptionButtonManche3 = True Then
    NbManche = 3
End If
If UserForm1.OptionButtonManche4 = True Then
    NbManche = 4
End If
If UserForm1.OptionButtonManche5 = True Then
    NbManche = 5
End If
 
For L = 1 To NbManche
    ' Numérotation aléatoire des joueurs
    For I = 1 To UBound(Tablo, 1)
      Tablo(I, UBound(Tablo, 2)) = Rnd
    Next I
    ' Tri en fonction du numérotage
    For I = 1 To UBound(Tablo, 1)
      For J = 1 To UBound(Tablo, 1)
        If Tablo(I, UBound(Tablo, 2)) > Tablo(J, UBound(Tablo, 2)) Then
          For k = 1 To UBound(Tablo, 2)
            temp = Tablo(I, k)
            Tablo(I, k) = Tablo(J, k)
            Tablo(J, k) = temp
          Next k
        End If
      Next J
    Next I
 
    With Sheets("P" & L)
      J = 4                                                           ' 1ère ligne
      Cl = 1
      Num = 0
      For I = 1 To Nb3                                                ' Pour toutes les triplettes
        For k = 0 To 2                                                ' Pour 3 joueurs
          Num = Num + 1                                               ' Indice dans le tableau : Tablo
          .Cells(J, Cl) = Tablo(Num, 1)
          Cl = Cl + 1
          If Cl = 7 Then
            Cl = 1
            J = J + 1
          End If
        Next k
      Next I
 
      For I = 1 To Nb2                                                ' Pour toutes les doublettes
        For k = 0 To 1                                                ' Pour 2 joueurs
          Num = Num + 1                                               ' Indice dans le tableau : Tablo
          .Cells(J, Cl) = Tablo(Num, 1)
          Cl = Cl + 1
          If Cl = 3 Then
            Cl = 4
          ElseIf Cl = 6 Then
            Cl = 1
            J = J + 1
          End If
        Next k
      Next I
 
    Set Plage = .Range("I4:I" & J - 1)
      For Each Cel In Plage
Autre:
        Alea = Int(9 * Rnd + 1)
        If Application.CountIf(Plage, Alea) Then GoTo Autre Else Cel = Alea
      Next Cel
    End With
  Next L
  Application.ScreenUpdating = True
End Sub

Je n'ai pas 36 solutions pour comprendre. On va reprendre étape par étape :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
With Sheets("Liste")
    Tablo = .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)
End With
NbJ = UBound(Tablo)

Là il semble que tu charges dans un tableau de variables chacun des inscrits sous la forme "00X Prénom" puis tu détermines le nombre de joueurs au total (NbJ).
Pas de souci.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
With Sheets("Recap")
    .Range("B3:B100").ClearContents
    For I = 1 To NbJ
      .Cells(I + 2, 2) = Tablo(I, 1)
    Next I
End With

Là tu copies les inscrits dans une feuille masquée, appelée "Recap". Là par contre, il y a un truc étrange : pourquoi ton tableau Tablo a deux dimensions ? Pourquoi Tablo(I, 1) plutôt que Tablo(I) ?
Deuxième truc étrange : les variables tableau ne commencent pas à Tablo(1) mais à Tablo(0). Donc je ne comprend pas. J'aurai remplacé Tablo(I, 1) par Tablo(I-1).
Au passage la déclaration de ton tableau Tablo est à reprendre

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim Tablo() As String

Bertrand

**MARGAR** · 24/08/2012, 21h16

Franchement, je ne sais plus car ce fichier date depuis plusieurs années.

S'il te semble qu'il y a des corrections à y faire, fais pour un mieux.

Marcel

**Bear the french** · 24/08/2012, 21h36

Après avoir vérifier dans mes tablettes, ton code est juste pour la partie tableau --> en affectant une plage, la deuxième dimension du tableau est créée automatiquement et elle correspond au numéro de la colonne. Le premier indice de ce tableau est 1 et non zéro. Va falloir que je révise un peu

Mes excuses pour cette erreur.

Par contre, je déclarerai bien

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim Tablo() As Variant

Bertrand

**MARGAR** · 24/08/2012, 21h44

Cool Bertrand, la zenattitude doit toujours primer...

Marcel

**Bear the french** · 24/08/2012, 21h53

Analysons la suite :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Select Case NbJ Mod 3                      ' Reste entier sur la division NbJ/3
    Case 0
      If (NbJ / 3) Mod 2 > 0 Then            ' Nombre équipe impair
        Nb3 = (NbJ / 3) - 2
        Nb2 = 3
      Else
        Nb3 = NbJ / 3
        Nb2 = 0
      End If
    Case 1
      If ((NbJ \ 3) - 1) Mod 2 = 0 Then      ' 1 équipe de 3 en moins = nombre pair
        Nb3 = (NbJ \ 3) - 1
        Nb2 = 2
      Else
        Nb3 = (NbJ \ 3) - 3
        Nb2 = 5
      End If
    Case 2
      If (NbJ \ 3) Mod 2 = 0 Then             ' Nombre équipe de 3 pair
        Nb3 = (NbJ \ 3) - 2
        Nb2 = 4
      Else
        Nb3 = (NbJ \ 3)
        Nb2 = 1
      End If
End Select

On cherche à calculer le Modulo du Nombre de joueurs divisé par 3.
Trois cas de figures :
- Modulo = 0
- Modulo = 1
- Modulo = 2

En bref, cette partie calcule le nombre de doublettes et le nombre de triplettes (ça, on savait déjà le faire).

C'est intéressant de noter que :
Nb3 = le nombre de triplettes
Nb2 = le nombre de doublettes

Bertrand

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
' On efface tous les tableaux
For L = 1 To 5
    Sheets("P" & L).Range("A4:H12,I4:I12").ClearContents
Next L

Ok pour effacer les anciens tableaux. L'information que je retiens : à priori un tournoi se joue en 5 manches ?

Bertrand

**MARGAR** · 24/08/2012, 22h05

En fait, c'est un programme qui tourne très bien mais le problème se pose au tirage aléatoire en créant des doublons, ce qui rend certains joueurs râleurs...

Marcel

Au départ, lorsque l'on inscrit les joueurs, avant de faire le tirage, on a le choix entre 3, 4 ou 5 manches.
En général, on joue 4 manches, rarement 5 et encore plus rarement 3.

Marcel

**Bear the french** · 24/08/2012, 22h17

Qu'est ce que tu appelles un doublon ?
Un même joueur dans deux équipes differentes ?

Bertrand

**MARGAR** · 24/08/2012, 22h28

un doublon, c'est 2 joueurs qui jouent 2 ou 3 fois ensemble, par ex :

Manche 1 : LEON / RITA / CLAUDY contre ALAIN / RENE / BOB

Manche 3 : on retrouve :

LEON / RITA / BERTRAND contre MARCEL / NADINE / JOEL.

Marcel

Algorythme et VBA

Macros et VBA Excel

Discussions similaires

Partager

Partager