XL pour MAC Tirages aléatoires avec critères

[Mickey Mouse]

Bonjour à toutes et tous .
je m'adresse à vous Afin d'avoir peut être la solution à ce qui m'occupe actuellement ...

Je souhaiterais générer automatiquement et aléatoirement 10 tirages loto en utilisant les 49 n° + 1 doublon (10 Combinaisons de 5 N° = 50 , vu qu'il n'y a que 49 n° un numéro sera utilisé 2 fois )
Générer des tirages aléatoires , je sais faire , mais j'aimerais que ces tirages répondent à des critères bien précis ....
J'aimerais en effet que le poids de chaque combinaison (la somme des chiffres contenus dans la combinaison : EX 1,2,3,4,5 = 15 ) soit compris entre 100 et 150 .
Que chaque combinaison contienne 2 chiffres Pairs et 3 Impairs ou 3 Pairs et 2 Impairs.
Que chaque combinaison soit composée de 3 ou 4 dizaines et de 4 ou 5 finales ...
Petit rappel : Il y à 5 dizaines ( 1 à 9 = 1 dizaine , 10 à 19 = une 2ème Dizaine , 20 à 29 = 3ème Dizaine , 30 à 39 = 4ème Dizaine , 40 à 49 = une 5ème dizaine )
En ce qui concerne les finales , il y en à 10 ( Finale 0 : 10,20,30,40 - Finale 1 : 1,11,21,31,41 , Finale 2 : 2,12,22,32,42 etc. ... jusqu'à la Finale 9 : 9,19,29 , 39 et 49 )
Exemples : 15,24,28,35,43 = 145 , 3 Impairs et 2 Pairs , 4 Finales et 4 dizaines .
Ci joint un tableau récapitulatif de mes attentes ...
je ne sais pas si cela est possible, en tous cas mon niveau d'excel, ne m'a. pas permis de trouver la solution .
Si quelqu'un est intéressé par le challenge , je lui en suis par avance reconnaissant , , je sais bien que cette requête ne revêt pas un caractère vital , mais la morosité ambiante invite à s'évader .
En vous remerciant par avance , pour les efforts et le temps passé .
Je vous souhaite un bonne journée .
dans l'attente de vous lire
Mickey

 

[crocrocro]

Bonjour le fil,
en pj une nouvelle version
Avec une dizaine de tirages, la solution est trouvée entre 0.5 seconde et 10 secondes ce qui représente 30 à 1000 essais. Et bizarrement, parfois ne trouve pas de solution avec 2 000 essais. Il suffit de relancer.
ci-dessous 10 tests successifs avec moins de 1 seconde en moyenne et moins de 500 essais par tirage

Un remarque par rapport aux règles :
comme le dernier tirage est de 4 n°, la règle de tolérance (pour finale, dizaine, Poids) est au prorata de la règle générale par exemple pour le Poids :
5 n° -> entre 100 et 150
4 n° -> entre 80 (=100 * 4/5) et 120 (= 150*4/5)

Le code

Sub TirageLoto()
Dim TableauAleatoire(1 To 49)
Dim i As Integer, j As Integer, Lig As Integer
Dim Doublon As Boolean, OK As Boolean, Fin As Boolean, Fin1Ligne As Boolean
Dim Note As Integer
Dim NbEssais As Integer
Const MAX_ESSAI = 2000
    Application.ScreenUpdating = False
    Range("TableauTirage").ClearContents
    NbEssais = 1
    Fin = False
    While Not Fin
        'à chaque essai :
        '   - on va faire un tirage ligne par ligne et non pour tout le tableau
        '   - si la ligne ne respecte pas les règles, on boucle sur la ligne
        '   - sinon on passe à la suivante
        '   - si tout est ok, c'est fini
        '   - pour la dernière ligne, on n'a pas le choix autre que l'ordre du tirage, donc 1 seul essai
        '   - si tout n'est pas ok, on repart du début jusqu'à atteindre le max d'essai
        Lig = 1
        Fin1Ligne = False
        While Not Fin1Ligne
            Randomize
            ' on remplit le tableau pour la ligne courante
            For i = (Lig * 5) - 4 To Application.Min(Lig * 5, UBound(TableauAleatoire))
                OK = False
                While Not OK
                    TableauAleatoire(i) = Int((UBound(TableauAleatoire)) * Rnd + 1)
                    Doublon = False
                    For j = 1 To i - 1
                        If TableauAleatoire(j) = TableauAleatoire(i) Then Doublon = True
                    Next j
                    If Not Doublon Then OK = True
                Wend
            Next i
            j = 0
            For i = (Lig * 5) - 4 To Application.Min(Lig * 5, UBound(TableauAleatoire))
                j = j + 1
                Range("TableauTirage").Cells(Lig, j) = TableauAleatoire(i)
            Next i
            Note = Range("NOTE")
            If Note = 0 Then
                If Lig = 10 Then
                    ' c'est fini OK
                    Fin1Ligne = True
                    Fin = True
                    MsgBox "Tirage OK en " & NbEssais & " essais.", vbExclamation, "Tirage Loto"
                Else
                    ' on passe à la ligne suivante
                    Lig = Lig + 1
                    NbEssais = NbEssais + 1
                End If
            Else
                If Lig = 10 Then
                    ' sur la dernière ligne, on ne peut rien améliorer -> on recommnce
                    Fin1Ligne = True
                    Range("TableauTirage").ClearContents
                    Erase TableauAleatoire

                Else
                    NbEssais = NbEssais + 1
                    If NbEssais >= MAX_ESSAI Then
                        Fin1Ligne = True
                        Fin = True
                        If Lig = 10 Then
                            MsgBox "Tirage KO après " & NbEssais & " essais.", vbCritical, "Tirage Loto"
                        Else
                            MsgBox "Tirage très KO après " & NbEssais & " essais.", vbCritical, "Tirage Loto"
                        End If
                    End If
                End If
            End If
        Wend
    Wend
End Sub

 

[crocrocro]

Bonjour le fil,
pour le fun, un version avec annonce des numéros après le tirage aléatoire (Lecture, Pause Reprise de lecture).
La feuille de calcul est masquée. L'annonce des numéros est faite (en plein écran) dans la feuille Tirage.