VBA : Utilisation d'un tableau (à trois dimensions ?)

Salut H2so4,

Un tout grand merci de continuer à m’aider si rapidement

Chacune de tes propositions est très étonnante et je reste baba de voir la rapidité de la Version 8 !

Quelques petits soucis subsistent cependant. Pour la Version 8, la durée est sensiblement la même pour tous les tirages, soit environ 5 secondes mais il y a des problèmes au sujet de la répartition des triplettes. Elles ne jouent parfois pas ensemble et parfois elles se retrouvent du même côté.

Pour l’instant, aucun souci visible avec la Version 7, mais elle est bien entendu plus lente. Quelques exemples : 25 joueurs en 30 secondes, 26 et 27 joueurs en 3 s., 44 et 50 joueurs en 65 s., 53 joueurs en 7 s. Cette ''lenteur'' serait un tout petit problème si les résultats étaient plus fiables qu’avec la version 8.

A toi de voir avec quelle version tu veux continuer, mais pour moi les deux conviendraient parfaitement.

Pour l’instant j’ai peu de temps à disposition, mais dès vendredi, j’aimerais modifier mon fichier afin que l’on puisse également tester avec plus de triplettes et que l’on puisse enregistrer les tirages effectués afin d’avoir des enregistrements réels - sur la feuille ‘’Archives’’ - des parties tirées.

Bonne soirée.

Bonsoir,

je continue avec l'algorithme génétique.

encore quelques bugs de supprimés

Re,

A nouveau ton travail est génial d’avancement. Tous les bugs constatés la dernière fois on disparus comme par enchantement (tu es plutôt magicien ou sorcier ? )

Dans un premier temps, j’ai modifié ce fichier afin de pouvoir contrôler des tirages jusqu’à 100 joueurs, ce qui me parait vraiment suffisant, avec de la marge.

Je suis impatient d’avoir le temps de pouvoir le modifier encore selon ce que je t’ai indiqué la dernière fois : plus de triplettes et enregistrement des parties simulées afin de pouvoir simuler une saison complète.

Chaleureusement.

bonjour,

Je suis impatient d’avoir le temps de pouvoir le modifier encore selon ce que je t’ai indiqué la dernière fois : plus de triplettes et enregistrement des parties simulées afin de pouvoir simuler une saison complète.

il faudra sans doute "tuner" l'algorithme génétique. Voici une version permettant de jouer sur les paramètres.

Salut H2so4,

Merci pour ton dernier message. A nouveau je n’ai pas tout compris, mais allons-y quand même

J’avais déjà avancé avec ta version 9 lorsque tu m’as fourni la version 10. J’ai donc simplement remplacé l’ancien module ‘’Modulegenetic’’ par le nouveau, j’ai ajouté ta nouvelle feuille ‘’paramètres algogen’’ et ça donne la version 11.

J’ai également placé dans cette version 11 une feuille ‘’ Relevés Eté 2019’’ - qui correspond à une saison complète réelle - et deux macros qui permettent soit d’utiliser une colonne de cette feuille pour un nouveau tirage (par l’intermédiaire de la macro ‘’ Essai_Bis’’ dans le module ‘’Tirage’’), soit de simuler une saison entière par l’intermédiaire de la macro ‘’ Tirage_une_saison’’ dans le même module.

Le fichier ci-joint nommé ‘’ essai tirage yvouillev11 - 52 tirages’’ est le résultat de la simulation d’une saison complète, sans limitation de terrains. J’ai constaté que les premiers tirages sont très rapides – alors que la feuille ‘’Archives’’ a été vidée - et que la macro prend de plus en plus de temps à effectuer un nouveau tirage au fur et à mesure que la feuille ‘’Archives’’ est complétée. Mais ceci parait normal.

Arrivé au bout de cette simulation – après environ15 à 30 minutes ? - je constate avec un peu de déception que le résultat n’est pas meilleur qu’avec mon ancien fichier. Lors de cette saison d’été 2019, seules deux paires de joueurs avaient dû jouer 3 fois ensemble dans la réalité (idem avec ton fichier) et 4 paires avaient joué un maximum de 5 fois ensemble (contre un maximum de 7 avec ce nouveau fichier).

En prenant ce fichier dans lequel sont déjà inscrits 52 matchs, si j’effectue un nouvel essai avec les 42 joueurs en place sur la feuille ‘’Base’’ (2 triplettes), un tirage dure environ 60 secondes sur ma machine ou 50 secondes si j’indique que le nombre de terrains est limités à 8 (info placée en F13 de la feuille ‘’Base’’, donc 10 triplettes au total). Afin de comparer des choses qui sont comparables, j’efface à chaque fois le dernier tirage par le bouton ‘’Effacer Dernière mêlée’’.

Je me dis alors que si les tirages pouvaient être améliorés (moins de 3 fois ensemble durant la saison d’été, sans limite de terrains), ça ne dérangerait pas que les tirages durent un peu plus longtemps. Je ne sais cependant pas quels paramètres de la feuille ‘’paramètres algogen’’ je dois changer afin d’améliorer la chose. Si tu veux bien me conseiller, je pourrais continuer à faire des essais.

J’ai voulu effectuer une autre simulation pour la saison d’hiver – avec seulement 8 terrains à disposition – mais la macro bloque après quelques tirages, autour de 20 environ, selon l’image ci-dessous.

J’ai tenté de remplacer les & par des # pour les deux variables q1 et q2, mais sans succès, ça bloque à nouveau sur la même instruction. Promis, juré, c’est la seule tentative de modification que j’ai faite dans tes codes

A tout hasard, je te montre un fichier en l’état du blocage nommé ‘’ essai tirage yvouillev11 - 52 tirages - Terrains limités - Avorté après 19 parties’’.

Au plaisir de te relire.

Bonjour,

1)la sélection de la meilleure grille se fait en 3 étapes. recherche des meilleures triplettes, recherche des meilleures doublettes, recherches des meilleures rencontres. Pour cette sélection des doublettes et des triplettes, on fait simplement la somme du nombre de fois que les joueurs ont joué l'un avec l'autre. pour la sélection des rencontres, on fait la somme du nombre de fois que les joueurs ont joué l'un contre l'autre et on sélection les équipes et les rencontres qui donnent le score le plus bas.

dans les versions précédentes, la pondération liée à 2 joueurs ayant joué plus de 2 fois l'un avec l'autre n'est pas assez pénalisante.

Dans cette nouvelle version j'ai fortement pénalisé les équipes dont les joueurs ont déjà joué 2 fois ensemble.

2)problème du type incompatible est corrigé, la macro ne contrôlait pas qu'il pouvait parfois ne pas y avoir de doublette.

Salut H2so4,

On s’approche du bonheur complet 😊

J’ai modifié une ou deux choses à mes macros et j’ai renommé ce fichier V13.

Suites à tes modifications à toi, les nouveaux résultats sont assez intéressants.

Saison d’été

En lançant une saison d’été complète avec un nombre illimité de terrains (ça dure environ 26 minutes), on constate que personne n’a joué plus de deux fois l’un contre l’autre (dans la réalité, avec mon ancien fichier, 2 paires ont joué 3 fois ensemble) et le nombre de paires qui ont joué un maximum de 5 fois l’un contre l’autre est juste un peu plus élevé que dans la réalité (10 contre 5). Mais du moment que ce maximum de 5 n’a pas été dépassé, c’est très bien. Je préfère qu'on ait gagné sur l'autre paramètre.

J’ai simulé 10 joutes de plus afin de voir l’évolution – mais aussi afin de contrôler si on a une certaine ‘’réserve’’ - et 2 paires de joueurs ont dû jouer 3 x ensemble et 2 paires ont joué 6 x ‘’contre’’. Les résultats sont visibles dans le fichier ci-joint pour ces 62 rencontres.

Si ça t’intéresse, sur la ‘’Feuille de match’’, j’ai relevé le temps qu’à duré chacune des 52 premières parties.

Saison d’hiver

Je n’ai pas voulu relever les joueurs exacts qui avaient joué la dernière saison d’hiver et j’ai testé une saison complète (durée 32 minutes) avec une limite de 8 terrains sur la base des joueurs présents l’été 2019, ce qui est quand même très représentatif.

Là également, les résultats sont très satisfaisants, voire encore plus intéressants.

Si la saison d’hiver 2018-2019 (la saison 2019-2020 ayant été interrompue par le coronavirus) 36 paires avaient joué 3 fois ensemble, avec ton fichier, ça tombe à 9 paires. Quant aux paires ayant joué ‘’contre’’, il n’y a que 6 paires ayant joué 6 fois ‘’contre’’ avec ta macro contre 3 paires ayant joué 7 fois ‘’contre’’ et 13 paires ayant joué 6 fois ‘’contre’’ durant la dernière saison complète !

Suite du travail

Je vais bien sûr devoir faire plus d’essais et remettre certaines fonctionnalités de mon ancien fichier dans celui-ci (possibilité de corriger le nom d’un joueur sur l’ensemble des feuilles, statistiques diverses, etc.) mais j’aurais d’abord une demande à te faire : sur la feuille ‘’Archives’’, j’ai ma colonne ‘’Terrain’’ en colonne N que j’aurais bien voulu déplacer en colonne D, tout en décalant les autres colonnes vers la droite. Quelle masse de travail ça représenterait pour toi (je pense être incapable de le faire moi) de corriger tes codes en fonction de ce changement ? Pour moi, ce serait juste un petit avantage, ne te gêne donc pas de dire si c’est trop demander.

Je te suis à nouveau très reconnaissant du temps que tu me consacres et te souhaite une bonne fin de Fêtes de Pâques.

bonjour,

En lançant une saison d’été complète avec un nombre illimité de terrains (ça dure environ 26 minutes), on constate que personne n’a joué plus de deux fois l’un contre l’autre (dans la réalité, avec mon ancien fichier, 2 paires ont joué 3 fois ensemble) et le nombre de paires qui ont joué un maximum de 5 fois l’un contre l’autre est juste un peu plus élevé que dans la réalité (10 contre 5). Mais du moment que ce maximum de 5 n’a pas été dépassé, c’est très bien. Je préfère qu'on ait gagné sur l'autre paramètre.

cela reste un tirage au hasard (dirigé certes mais au hasard), il n'y a donc pas de garantie de trouver le meilleur résultat et donc parfois, s'il ne trouve pas mieux, tu auras des paires qui auront joué plus de fois ensemble, ou des paires ayant joué plus de 5 fois l'une contre l'autre, surtout si la taille de ton archive augmente.

voici une version adaptée pour des terrains en colonne D sur la feuille archive. Cette modification entraîne une erreur dans ton code, je n'ai pas regardé.

Salut H2so4,

Un tout grand merci pour tes dernières modifications. J'ai également fait les miennes et ça fonctionne à merveille.

h2so4 a écrit :

cela reste un tirage au hasard (dirigé certes mais au hasard), il n'y a donc pas de garantie de trouver le meilleur résultat et donc parfois, s'il ne trouve pas mieux, tu auras des paires qui auront joué plus de fois ensemble, ou des paires ayant joué plus de 5 fois l'une contre l'autre, surtout si la taille de ton archive augmente.

Je ne sais pas si je me suis mal exprimé, mais je suis totalement conscient de la chose, je t'ai même dis que j'étais très content des résultats obtenus

A titre d'information, voici un résumé des simulations de saisons complètes avec deux essais sur la dernière version :

Comme c'est la partie en brun qui compte le plus pour moi, c'est parfait ainsi.

Comme déjà dit, je vais continuer à transformer ce fichier et me permettrai de revenir à la charge si nécessaire.

Merci du fond du coeur pour ton aide.

Salut H2so4,

Je travaille encore sur mon fichier et tes macros me sont toujours for utiles

En début de saison, le code total effectue un tirage en une fraction de seconde. Puis plus la feuille ‘’Archives’’ est complétée, plus ça va long (de 30 secondes à une minute en fin de saison).

J’aurais donc voulu afficher un UserForm indiquant l’avancement du travail.

J’ai un peu joué à l’apprenti sorcier et ai tenté de placer un code récupérer d’un autre fichier au milieu de tes boucles afin de voir laquelle durait le plus longtemps, mais le résultat n’est pas satisfaisant.

Sais-tu ce que je fais de faux ? Et si tu ne veux ou ne peux pas m’aider sur ce coup-là, pourrais-tu au moins me dire quelles sont tes boucles qui durent le plus longtemps et sur lesquelles je pourrais continuer à trouver une solution ?

2 infos su tu acceptes de te pencher sur ce problème :

• Afin de simuler une mêlée, tu peux sélectionner par exemple 20 cellules en colonne C, cliquer sur le bouton ‘’Inverser une plage’’ vers H17 puis sur ‘’Lancer une mêlée’’ en H2.
• Mes tentatives mises en commentaire se trouvent dans le module ‘’ H2so4_Comptepaires’’, dans la macro ‘’ TirageH2so4’’. Recherche possible avec le mot-clé ‘’ UserForm_Progression’’ dans ce module.

J'ai dû passer par le site C-joint car mon fichier est trop volumineux, malgré qu'il est compressé :

A te relire.

bonjour Yvouille,

la partir du code qui prend le plus de temps se situe dans l'algorithme genetique.

j' y ai intégré le userform de progression et désactivé le message sur la barre de statut.

Function genetic(st$, feval$)
    Dim i&, bgen$, ngeneration&, genes$, k1&, k2&, t As Single, temp, nombremutation&, pctmut, mingen, maxgen, facgen, nenfants, pct1, pct2, genpct
    Dim tabgen(4, 2), bg(3)
    With Sheets("paramètres algogen")
        mingen = .Range("B2")
        maxgen = .Range("B3")
        facgen = .Range("B4")
        pctmut = .Range("B5")
        nenfants = .Range("B6")
        pct1 = nenfants * 0.5
        pct2 = nenfants * 7 / 8
    End With
    bgen = st
    For i = 1 To 4
        tabgen(i, 1) = bgen$
        tabgen(i, 2) = 9000000000#
    Next i
    ngeneration = facgen * Len(st)
    If ngeneration < mingen Then ngeneration = mingen
    If ngeneration > maxgen Then ngeneration = maxgen
    genpct = ngeneration
    Do While ngeneration > 0
        ngeneration = ngeneration - 1
        DoEvents
        UserForm_Progression.Show vbModeless
        UserForm_Progression.Label1.Width = UserForm_Progression.Frame1.Width * (genpct - ngeneration) / genpct
        UserForm_Progression.Repaint
        For i = 1 To 3
            bg(i) = tabgen(i, 1)
        Next i

        For i = 1 To nenfants
            If i < pct1 Then bgen = bg(1) Else If i < pct2 Then bgen = bg(2) Else bgen = bg(3)
            nombremutation = Int(pctmut * Len(bgen) * i / 10) + 1
            genes$ = mutation(bgen$, nombremutation)
            Select Case feval
                Case "s3"
                    t = evalues3(genes)
                Case "s2"
                    t = evalues2(genes)
                Case "eq"
                    If Len(genes) Mod 2 = 0 Then
                        t = evalueeq(genes)
                    Else
                        t = evalueeq(Left(genes, Len(genes) - 1))
                    End If
            End Select
            tabgen(4, 1) = genes
            tabgen(4, 2) = t
            'If t < tabgen(1, 2) Then Application.StatusBar = genes & ":" & t
            If t < tabgen(3, 2) Then 'trie tabgen on garde les 3 meilleures sequences
                For k1 = 1 To 3
                    For k2 = k1 + 1 To 4
                        If tabgen(k1, 2) > tabgen(k2, 2) Then temp = tabgen(k1, 1): tabgen(k1, 1) = tabgen(k2, 1): tabgen(k2, 1) = temp: temp = tabgen(k1, 2): tabgen(k1, 2) = tabgen(k2, 2): tabgen(k2, 2) = temp
                    Next k2
                Next k1
            End If
            If tabgen(1, 2) = 0 Then ngeneration = 0: Exit For
        Next i
    Loop
    genetic = tabgen(1, 1)
End Function

si tu veux améliorer les performances, tu peux jeter un oeil sur les fonctions évaluations des gènes, evalue3s (qui évalue si la composition des triplettes est optimale), evalue2s (qui évalue si la composition des doublettes est optimale) et evalueeq (qui évalue si les rencontres sont optimales)

Salut H2so4,

Merci beaucoup pour ce nouveau pas en avant

Ton rajout pour la barre de progression fonctionne très bien mais j’aurais quand même une question.

Cette barre de progression recommence 3, 4 fois à zéro. Serait-il possible de placer un compteur à un certain endroit de la macro qui permettrait d’afficher dans le UserForm à l’écran : Partie 1, Partie 2, etc. ? J’ai tenté de le faire à l’endroit où tu as posé ce nouveau passage, mais le texte change alors continuellement.

Si ce n'est pas possible, ce n'est pas bien grave.

Ensuite, tu me rappelles qu’il est possible de modifier les paramètres de la plage B2:B6 de la feuille ‘’paramètres algogen’’, ce que j’avais un peu oublié, tellement concentré sur le reste du problème. Mais les essais à effectuer sont tellement longs – je dois simuler une saison complète afin de connaitre les résultats globaux et ça dure pour l’instant 20 à 25 minutes – que je ne sais où commencer. J’ai bien tenté de relire les instructions que tu as placé directement sur cette feuille ou dans ton dernier message, mais c’est un peu du chinois pour moi.

Pourrais-tu alors m’indiquer une série de données que tu me conseilles d’inscrire dans cette plage B2:B6 pour faire un premier essai ? Comme la durée actuelle d’un tirage individuel en fin de saison dure actuellement environ 1 minute et 15 secondes sur mon ordi, il ne faudrait pas que ça dépasse deux minutes et quelque. Après avoir effectuer un tel essai sur un saison complète sur la base de tes conseils, je pourrai me rendre compte si ça vaut la peine ou non de prolonger la durée des tirages afin d’obtenir un mélange encore plus efficace des joueurs.

Cordiales salutations.

bonsoir Yvouille,

suggestion de valeurs pour les paramètres B2 à B6

• 150

• 300 <- au plus il y a de générations au plus grande la probabilité de tomber sur un "bon" gène.

• 20

• 10%

• 250 <- au plus il y a d'invidus au plus grande la probabilité de tomber sur un individu qui aura le "bon" gène.

ces 2 facteurs influencent proportionnelement le temps d'execution. (au plus grand le facteur, au plus long sera le traitement)

ajout des phases dans le formulaire de progression

Function genetic(st$, feval$, Optional phase = "")
    Dim i&, bgen$, ngeneration&, genes$, k1&, k2&, t As Single, temp, nombremutation&, pctmut, mingen, maxgen, facgen, nenfants, pct1, pct2, genpct
    Dim tabgen(4, 2), bg(3)
    With Sheets("paramètres algogen")
        mingen = .Range("B2")
        maxgen = .Range("B3")
        facgen = .Range("B4")
        pctmut = .Range("B5")
        nenfants = .Range("B6")
        pct1 = nenfants * 0.5
        pct2 = nenfants * 7 / 8
    End With
    bgen = st
    For i = 1 To 4
        tabgen(i, 1) = bgen$
        tabgen(i, 2) = 9000000000#
    Next i
    ngeneration = facgen * Len(st)
    If ngeneration < mingen Then ngeneration = mingen
    If ngeneration > maxgen Then ngeneration = maxgen
    genpct = ngeneration
 UserForm_Progression.Caption = "Progression " & phase
    Do While ngeneration > 0
        ngeneration = ngeneration - 1
        DoEvents
        UserForm_Progression.Show vbModeless
        UserForm_Progression.Label1.Width = UserForm_Progression.Frame1.Width * (genpct - ngeneration) / genpct
        UserForm_Progression.Repaint
        For i = 1 To 3
            bg(i) = tabgen(i, 1)
        Next i

        For i = 1 To nenfants
            If i < pct1 Then bgen = bg(1) Else If i < pct2 Then bgen = bg(2) Else bgen = bg(3)
            nombremutation = Int(pctmut * Len(bgen) * i / 10) + 1
            genes$ = mutation(bgen$, nombremutation)
            Select Case feval
                Case "s3"
                    t = evalues3(genes)
                Case "s2"
                    t = evalues2(genes)
                Case "eq"
                    If Len(genes) Mod 2 = 0 Then
                        t = evalueeq(genes)
                    Else
                        t = evalueeq(Left(genes, Len(genes) - 1))
                    End If
            End Select
            tabgen(4, 1) = genes
            tabgen(4, 2) = t
            'If t < tabgen(1, 2) Then Application.StatusBar = genes & ":" & t
            If t < tabgen(3, 2) Then 'trie tabgen on garde les 3 meilleures sequences
                For k1 = 1 To 3
                    For k2 = k1 + 1 To 4
                        If tabgen(k1, 2) > tabgen(k2, 2) Then temp = tabgen(k1, 1): tabgen(k1, 1) = tabgen(k2, 1): tabgen(k2, 1) = temp: temp = tabgen(k1, 2): tabgen(k1, 2) = tabgen(k2, 2): tabgen(k2, 2) = temp
                    Next k2
                Next k1
            End If
            If tabgen(1, 2) = 0 Then ngeneration = 0: Exit For
        Next i
    Loop
    genetic = tabgen(1, 1)
End Function

Sub TirageH2so4()
    ' établissement d'une grille de rencontres avec des equipes constituées de joueurs ayant joué le moins souvent ensemble et le moins souvent l'un contre l'autre.
    Dim strip$, sdoub$
    Set wsb = Sheets("base")
    Set dictdouble = CreateObject("scripting.dictionary")
    Set dicttriple = CreateObject("scripting.dictionary")
    Set dicteq = CreateObject("scripting.dictionary")

    'chargement d'une table des joueurs en triplette et en doublette
    meilleuretriplette = ""
    With wsb
        dl = .Cells(Rows.Count, 7).End(xlUp).Row
        For i = 2 To dl
            If .Cells(i, "K") = "T" Then
                triplette = triplette + 1
                strip$ = strip & Chr(dict(.Cells(i, 7).Value) + 64)
            Else
                doublette = doublette + 1
                sdoub$ = sdoub & Chr(dict(.Cells(i, 7).Value) + 64)
            End If

            '            If i Mod 1000 = 0 Then DoEvents
            '            UserForm_Progression.Show vbModeless
            '            UserForm_Progression.Label1.Width = UserForm_Progression.Frame1.Width * (i / dl)
            '            UserForm_Progression.Repaint

        Next i

        ' constitution de triplette avec des joueurs ayant joués le moins souvent ensemble
        If Int(triplette / 3) = 1 Then
            meilleuretriplette = strip
        ElseIf triplette > 3 Then
            meilleuretriplette = genetic(strip, "s3", "phase 1")
        Else
            meilleuretriplette = ""
        End If

        With .Range("M2")
            s = meilleuretriplette
            For i = 1 To Len(s)
                .Cells(i, 2) = "equipe " & Int((i - 1) / 3) + 1
                s1 = Asc(Mid(s, i, 1)) - 64
                .Cells(i, 1) = wsb.Cells(s1 + 1, 1)

                '            If i Mod 1000 = 0 Then DoEvents
                '            UserForm_Progression.Show vbModeless
                '            UserForm_Progression.Label1.Width = UserForm_Progression.Frame1.Width * (i / Len(s))
                '            UserForm_Progression.Repaint

            Next i
        End With

        'consitution de doublette avec des joueurs ayant joués le moins souvent ensemble

        If sdoub <> "" Then
            meilleuredoublette = genetic(sdoub, "s2", "Phase 2")
            With .Range("M2").Offset(Len(s), 0)
                s = meilleuredoublette
                For i = 1 To Len(s)
                    .Cells(i, 2) = "equipe " & Int((i - 1) / 2) + triplette / 3 + 1
                    s1 = Asc(Mid(s, i, 1)) - 64
                    .Cells(i, 1) = wsb.Cells(s1 + 1, 1)

                    '            If i Mod 1000 = 0 Then DoEvents
                    '            UserForm_Progression.Show vbModeless
                    '            UserForm_Progression.Label1.Width = UserForm_Progression.Frame1.Width * (i / Len(s))
                    '            UserForm_Progression.Repaint

                Next i
            End With
        End If
    End With

    ' constitution du tableau des pondérations equipeoppose, on calcule pour chaque équipe les nombres de fois que chacun de ses joueurs a rencontré les joueurs des autres équipes
    creetableauequipeopposee

    ' recherche de la meilleure combinaison de rencontres
    s = recherchemeilleurecombinaisonderencontre(equipe, triplette / 3) ' s=liste des equipes dans l'ordre

    ' affichage du resultat

    With Sheets("Rencontres")
        .Cells.Clear
        .Range("B1") = "equipe 1"
        .Range("C1") = "equipe 2"
        For i = 1 To Len(s) Step 2
            terrain = terrain + 1
            .Cells(terrain + 1, 1) = "Terrain " & terrain
            score = 0
            For k = 0 To 1
                numeroequipe = Asc(Mid(s, i + k, 1)) - 64
                membreequipe = Split(equipe(numeroequipe), "|")
                stequipe = ""
                For k1 = 1 To UBound(membreequipe)
                    stequipe = stequipe & Sheets("base").Cells(membreequipe(k1) + 1, 1) & " - "
                Next k1
                .Cells(terrain + 1, k * 1 + 2) = Left(stequipe, Len(stequipe) - 3)
            Next k
        Next i
        .Range("A1").Resize(terrain + 1, 3).Borders.Weight = xlThin
        .Range("A1:C1").EntireColumn.AutoFit
    End With

    'affichage du score
    With Sheets("Rencontres")
        score = 0
        For i = 1 To terrain
            seq$ = Mid(s, (i - 1) * 2 + 1, 2)
            eq1 = Split(.Cells(i + 1, 2), " - ")
            eq2 = Split(.Cells(i + 1, 3), " - ")
            st = ""
            For j = LBound(eq1) To UBound(eq1)
                st = st & Chr(dict(eq1(j)) + 64)
            Next j
            If Len(st) = 2 Then score = score + evalues2(st) Else score = score + evalues3(st)
            st = ""
            For j = LBound(eq2) To UBound(eq2)
                st = st & Chr(dict(eq2(j)) + 64)
            Next j
            If Len(st) = 2 Then score = score + evalues2(st) Else score = score + evalues3(st)
            st = ""
            score = score + evalueeq(seq)
        Next i
        .Cells(1, 4) = score
    End With
End Sub

Function recherchemeilleurecombinaisonderencontre(equipe, ntriplette)
    ' fonction qui renvoie sous forme d'une chaine de caractères la liste des équipes qui prises 2 à 2 renvoie la grille optimum des rencontres pour les joueurs sélectionnés
    Dim seq3$, seq2$, nseq3$, nseq2$
    ms = ""
    meilleureeq = ""
    For i = 1 To ntriplette
        seq3 = seq3 & Chr(i + 64)
    Next i
    If ntriplette > 2 Then
        s = genetic(seq3, "eq""Phase 3")
    ElseIf ntriplette = 2 Then
        s = seq3
    Else
        s = ""
    End If
    eq2 = 0
    seq2 = ""
    For i = 1 To UBound(equipe)
        If InStr(s, Chr(i + 64)) = 0 Then
            eq2 = eq2 + 1
            seq2 = seq2 & Chr(i + 64)
        End If
    Next i
    meilleureeq = ""
    If seq2 <> "" Then
        meilleureeq = genetic(seq2, "eq", "Phase 4")
    End If
    s = s & meilleureeq
    recherchemeilleurecombinaisonderencontre = s
End Function

Salut H2so4,

Merci pour tes nouvelles solutions

Concernant les textes qui apparaissent à l’écran, c’est juste parfait. Avec tes modifications, j’arrive à changer – en plus du titre du UserForm dont tu t’es occupé – les textes des Label dans la forme. Du pur bonheur.

Au sujet de l’amélioration des résultats en fonction des paramètres inscrits sur la feuille ‘’ paramètres algogen’’, c’est moins probant.

Avec les valeurs suggérées, je ne peux vraiment pas dire qu'il y a une nette amélioration au niveau du nombre de fois que les joueurs ont joué ensemble alors que le temps de tirage est de plus du double.

En détail, après deux essais avec les premières valeurs en place et 3 essais avec les valeurs plus sévères, à chaque fois pour des saisons complètes :

Sans autre proposition de ta part, je vais donc laisser les premières valeurs que tu avais inscrites.

Pour l’instant j’avance avec d’autres parties de ce projet, mais à nouveau, je tiens à te dire à quel point tu m’as permis d’avancer : MERCI

Très bonnes salutations.