Discussion :

[MARGAR]

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]

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]

Salut Bertand,

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

Cordialement

Marcel

[Bear the french]

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]

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

[MARGAR]

@ 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]

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