Tirage loto aleatoire

[NICOALBERT]

Bonjour le Forum ,

Je suis en train de me faire un petit fichier et je souhaiterais faire des tirages aléatoires mais pas sur tout les nN° uniquement ceux présent dans les 2 tableaux.

Quelqu'un peut il m'aider.

Cordialement.

 

[NICOALBERT]

Re : Tirage loto aleatoire

Bonjour ,

le soucis c que si je ne laisse que 5 n° dans le 1er tableau sa me sort quant même les autres , chose qui ne devrait pas.

Si dans le tableaux il ne reste que 10 N° le tirage aléatoire ne doit se faire qu'avec ces N°.

Cordialement.

 

[NICOALBERT]

Re : Tirage loto aleatoire

Comme je l'ai mis dans le fichier joint, seul les N° : 1 ; 5 ; 8 ; 10 ; 13 ; 15 ; 19 ; 20 ; 23 ; 26 ; 28 ; 32 ; 35 ; 40 ; 46 ; 48 . pour le tirage des 5 Boules .

Et le N° : 1 ; 5 ; 6 ; 10 . pour le N° Complémentaire .

 

[excfl]

Re : Tirage loto aleatoire

Bonsoir Jean-Marcel,

Post 2 :

Le fichier est bien conçu, mais comment éviter les doublons ?

excfl

 

[ROGER2327]

Re : Tirage loto aleatoire

Bonsoir à tous

Une autre proposition en pièce jointe. Pas de souci avec des séries incomplètes (voire avec aucune donnée...)​

ROGER2327
#6347

Vendredi 6 Décervelage 140 (Saints Polonais, prolétaires - fête Suprême Quarte)
14 Nivôse An CCXXI, 8,2543h - grès
2013-W01-4T19:48:37Z

 

[NICOALBERT]

Re : Tirage loto aleatoire

Re-bonsoir ,

C'est exactement ce que je chercher , c du très bon boulot .

J'ai regarder le code mais vraiement trop novice pour le comprendre .

Cordialement.

 

[ROGER2327]

Re : Tirage loto aleatoire

Re...

(...)

J'ai regarder le code mais vraiement trop novice pour le comprendre .

(...)

Le code est assez simple. Quelques commentaires vous aideront probablement à le comprendre :​

Sub Tirage1() 'Code associé au bouton "Nouvelle Grille"
    Range("B9:F24,H9:H24").ClearContents
    Tirage
End Sub

Sub Tirage2() 'Code associé au bouton "Grille Supplémentaire"
Dim ofs&, t
    With [B25]
        If Not IsEmpty([B9]) Then 'Recheche du décalage de la ligne de sortie
        'par rapport à la première ligne de sortie (ici : la ligne 9)
            t = .Value
            .Cells = Empty
            ofs = .End(xlUp).Offset(1).Row - 9
            .Value = t
        End If
    End With
    If ofs < 16 Then Tirage ofs
End Sub

Sub Tirage(Optional ofs&)
Dim i&, j&, n&, t, p(), v(), Cel As Range
    Randomize
'Paramètres : tableau de référence aux plages de données et de résultats
    p = Array(Array("B1:K5", "B9:F9"), Array("B7:K7", "H9"))
    For j = 0 To UBound(p)
        For Each Cel In Range(p(j)(0)) 'Recherche des données
            If Not IsEmpty(Cel) Then n = n + 1: ReDim Preserve v(1 To n): v(n) = Cel.Value
        Next
        For i = n To 2 Step -1 'Mélange aléatoire des données
            t = v(1): v(1) = v(1 + Int(n * Rnd)): v(1 + Int(n * Rnd(0))) = t
        Next
        ReDim Preserve v(1 To 5)
        Range(p(j)(1)).Offset(ofs) = v 'Sortie des résultats
        Erase v
        n = 0
    Next
End Sub

Si ce n'est pas suffisant, dites-le.​

Bon courage.


ROGER2327
#6349

Vendredi 6 Décervelage 140 (Saints Polonais, prolétaires - fête Suprême Quarte)
14 Nivôse An CCXXI, 8,9533h - grès
2013-W01-4T21:29:17Z

 

[excfl]

Re : Tirage loto aleatoire

Re,

A partir du très bon travail de ROGER2327, le fichier joint permet

à la fin du ou des tirage(s) de trier les numéros sortis.

excfl

 

[Modeste geedee]

Re : Tirage loto aleatoire

Bonsour®

Comme je l'ai mis dans le fichier joint, seul les N° : 1 ; 5 ; 8 ; 10 ; 13 ; 15 ; 19 ; 20 ; 23 ; 26 ; 28 ; 32 ; 35 ; 40 ; 46 ; 48 . pour le tirage des 5 Boules .

Et le N° : 1 ; 5 ; 6 ; 10 . pour le N° Complémentaire .

autre proposition pour le fun...

il est possible qu'il y ait des doublons,
envisager alors l'utilisation de scripting dictionnary

 

[ROGER2327]

Re : Tirage loto aleatoire

Bonjour à tous

Si l'on retient l'idée de classement avancée par excfl, je propose :​

Sub tri()
Dim i&, j&, k&, ofs&, t, v(), plg As Range
    Set plg = [B9]
    With [B25]
        If Not IsEmpty(plg) Then
            t = .Value
            .Cells = Empty
            ofs = .End(xlUp).Offset(1).Row - plg.Row
            .Value = t
        End If
    End With
    v = plg.Resize(ofs, 5).Value
    For i = 1 To ofs
    For j = 5 To 2 Step -1
    For k = j - 1 To 1 Step -1
        t = v(i, k)
        If t > v(i, j) Then v(i, k) = v(i, j): v(i, j) = t
    Next k, j, i
    plg.Resize(ofs, 5) = v
End Sub

ROGER2327
#6352

Samedi 7 Décervelage 140 (Saints Forçats, pollorcètes - fête Suprême Quarte)
15 Nivôse An CCXXI, 5,8949h - lapin
2013-W01-5T14:08:52Z