mélanger aléatoirement des résultat

julien clerc

XLDnaute Junior
bonjour a tous j'ais un petit problème car je n'arrive pas a mélanger aléatoirement une liste de combinaisons si quelqu’un prouvé m'aider voici ma feuille de résultat que je voudrais mélanger aléatoirement

Sub combinaisons()
lin = 1
col = 1
For m = 1 To 20
For n = m + 1 To 20
For o = n + 1 To 20
For p = o + 1 To 20
For q = p + 1 To 20
Cells(lin, col) = m & " " & n & " " & " " & o & " " & p & " " & q
lin = lin + 1
If lin > 65536 Then
col = col + 1
lin = 1
End If
Next q
Next p
Next o
Next n
Next m
End Sub

merci de votre aide
 

Dormeur74

XLDnaute Occasionnel
Re : mélanger aléatoirement des résultat

Tu peux toujours essayer cette macro :

Code:
Option Explicit

Sub combinaisons()
    Dim lin As Long, col As Long
    Dim m As Integer, n As Integer, o As Integer, p As Integer, q As Integer
    Dim y As Integer
    
    lin = 1
    col = 1
    For m = 1 To 20
        For n = m + 1 To 20
            For o = n + 1 To 20
                For p = o + 1 To 20
                    For q = p + 1 To 20
                        Cells(lin, col) = m & " " & n & " " & " " & o & " " & p & " " & q
                        lin = lin + 1
                        If lin > 65536 Then
                            col = col + 1
                            lin = 1
                        End If
                    Next q
                Next p
            Next o
        Next n
    Next m
    
    MsgBox "Veuillez patienter pendant le calcul des tirages aléatoires (environ 20 secondes)."
    
    For y = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        Cells(y, 2).FormulaR1C1 = "=RAND()"
    Next y
    
    Cells.Select
    Range("A15478").Activate
    Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Columns("B:B").Select
    Range("B15478").Activate
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select

End Sub
 

Dormeur74

XLDnaute Occasionnel
Re : mélanger aléatoirement des résultat

Alors tu peux caler tes tirages aléatoires sur l'horloge de ta machine :
Code:
Sub combinaisons()
    Dim lin As Long
    Dim m As Integer, n As Integer, o As Integer, p As Integer, q As Integer
    Dim x As Long, y As Long
    Dim tableau() As Double, alea As Double
    Dim compteur As Long
    Dim doublon As Boolean
   
    lin = 0
    For m = 1 To 20
        For n = m + 1 To 20
            For o = n + 1 To 20
                For p = o + 1 To 20
                    For q = p + 1 To 20
                        lin = lin + 1
                        Cells(lin, 1) = m & " " & n & " " & " " & o & " " & p & " " & q
                    Next q
                Next p
            Next o
        Next n
    Next m
    
    Randomize Timer
    
    MsgBox "Veuillez patienter pendant le tirage aléatoire (environ 5 à 10 secondes)."
    
    ' on stocke les tirages aléatoires dans un tableau
    lin = Cells(Rows.Count, 1).End(xlUp).Row
    ReDim tableau(lin)
    
    Do
        alea = Rnd() * 100000
        doublon = False
        For y = 1 To lin
            If tableau(y) = alea Then
                doublon = True
                Exit For
            End If
        Next y
        If doublon = False Then
            compteur = compteur + 1
            tableau(compteur) = alea
        End If
    Loop Until compteur = lin
    
    For y = 1 To lin
        Cells(y, 2) = tableau(y)
    Next y
    
    Cells.Select
    Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft

End Sub
 

julien clerc

XLDnaute Junior
Re : mélanger aléatoirement des résultat

alors ça fonctionne très bien ! ;) je suis satisfait du mélange , MAIS juste 1 petit problème quand j'applique le code sur un nombre de combinaison plus élevé rien ne fonctionne je perd la moitié des combinaisons si tu peux jeter un coup oeil voici mon ma vba des base :
Sub combinaisons()
Dim lin&, col&, rc&, m%, n%, o%, p%, q%, tir$()
lin = 1
col = 0
rc = Rows.Count
ReDim tir(1 To rc, 0)
For m = 1 To 49
For n = m + 1 To 49
For o = n + 1 To 49
For p = o + 1 To 49
For q = p + 1 To 49
tir(lin, col) = m & " " & n & " " & o & " " & p & " " & q
lin = lin + 1
If lin > rc Then
col = col + 1
lin = 1
ReDim Preserve tir(1 To rc, col)
End If

Next q
Next p
Next o
Next n
Next m
Range(Cells(1, 1), Cells(rc, col + 1)).Value = tir
End Sub


merci beaucoup
 

Dormeur74

XLDnaute Occasionnel
Re : mélanger aléatoirement des résultat

Normal, tu avais mis 20 dans le dur, c'est la raison pour laquelle j'ai viré le changement de colonne : une seule suffisait. A 20 ça passait, mais pas à 49.
Là, il faut un autre algo.
 
Dernière édition:

Dormeur74

XLDnaute Occasionnel
Re : mélanger aléatoirement des résultat

A 49, j'ai bien peur qu'il ne soit plus simple d'apprendre l'assembleur correspondant au proc que tu utilises.
J'ai jeté l'éponge quand mon PC à fait fumer une tasse de café oubliée sur la tour depuis des heures.
Si tu veux refaire la Française des Jeux, mets-toi d'abord au hand-ball :cool:
 

eriiic

XLDnaute Barbatruc
Re : mélanger aléatoirement des résultat

Bonsoir,

As-tu vu que ça faisait 228 826 080 de combinaisons ?
Si tu lis vite, à 3s par combinaison, sans faire de pause ça te prendra plus 21 ans pour tout lire...
Quel est le but et surtout l'utilité ???
Remet toi à la chanson c'est plus cool ;-)

eric
 
J

JJ1

Guest
Re : mélanger aléatoirement des résultat

Bonjour à tous,

Les épouses et proches des handballeurs sont chanceux au jeu FDJ... hi hi j'adore l'humour!
@ julien clerc "ce n'est rien" mais à quoi sert cet algo car 1 2 3 4 5 gagne mais 1 3 2 5 4 aussi ?
Il faudrait nous en dire plus pour t'aider et avancer.


Bonne journée
 

julien clerc

XLDnaute Junior
Re : mélanger aléatoirement des résultat

re non 5 num /49 donne 1906884 combinaison et non
228 826 080 ! ce qui est beaucoup ! je cherche à les mélanger de façon complètement aléatoire , le deuxième code était trés bien mais il fonctionne uniquement pour 20 num ! dommage .
quand à la française des jeux il se trouve que j'ais jouer ce jour là et devinez quoi j'ai gagner !;)
 

Dormeur74

XLDnaute Occasionnel
Re : mélanger aléatoirement des résultat

Je n'ai pas voulu intervenir sur le nombre d'arrangements (mes bases en maths datent tellement que je ne sais plus si le mot est juste) annoncé, mais je suis resté également sur la valeur de 1906884 (occurrence 20). Cela dit, j'ai une mémoire de masse imposante, une mémoire vive normale pour 2012 et un tout petit Excel 2003 qui m'a coûté si cher que je n'ai pas du tout envie de l'upgrader. Donc pour moi ce sera 256 colonnes au lieu des 16384 offertes à partir de la version 2007 (je crois).

Ce qui ne change rien au problème. On ne sait toujours pas ce que tu veux faire de ce 49-tue-proc qui me tirebouchonne. En dehors de 7x7, du Maine-et-Loire et de mon année préférée en Cheval Blanc, ce chiffre ne me dit rien.
 

julien clerc

XLDnaute Junior
Re : mélanger aléatoirement des résultat

salut à tous , on modifiant le code précédant comme ceci ,

Sub combinaisons()
Dim lin As Long, col As Long
Dim m As Integer, n As Integer, o As Integer, p As Integer, q As Integer
Dim x As Long, y As Long
Dim tableau() As Double, alea As Double
Dim compteur As Long
Dim doublon As Boolean
lin = 1
col = 1
For m = 1 To 49
For n = m + 1 To 49
For o = n + 1 To 49
For p = o + 1 To 49
For q = p + 1 To 49
Cells(lin, col) = m & " " & n & " " & " " & o & " " & p & " " & q
lin = lin + 1
If lin > 65536 Then
col = col + 1
lin = 1
End If
Next q
Next p
Next o
Next n
Next m


Randomize Timer

MsgBox "Veuillez patienter pendant le tirage aléatoire (environ 5 à 10 secondes)."

' on stocke les tirages aléatoires dans un tableau
lin = Cells(Rows.Count, 1).End(xlUp).Row
ReDim tableau(lin)

Do
alea = Rnd() * 100000
doublon = False
For y = 1 To lin
If tableau(y) = alea Then
doublon = True
Exit For
End If
Next y
If doublon = False Then
compteur = compteur + 1
tableau(compteur) = alea
End If
Loop Until compteur = lin

For y = 1 To lin
Cells(y, 2) = tableau(y)
Next y

Cells.Select
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft

End Sub:



ça ne mélange pas tous et surtout la moitié des combinaison disparaisse :confused::confused:

avez vous une solution ?
 

eriiic

XLDnaute Barbatruc
Re : mélanger aléatoirement des résultat

Bonjour,

Excuse, j'ai cru que tu générais les arrangements et non les combinaisons.
Ca ne fait plus que 2 mois de lecture non stop, plus facile... ;-)

Je ne vois pas pourquoi tu ne te contentes pas d'un tirage aléatoire de 50, 100 ou même 1000 combinaisons.
Mais bon, tu ne veux pas exposer le but ultime, voici quand même une proposition en PJ.
Le mélange est effectué par permutation 2 à 2 de toutes les cellules.
Pour éviter des vides dispersés à droite et à gauche j'ai mis tes combinaisons dans une table 7567*252.

eric
 

Pièces jointes

  • combinaisons.xlsm
    21.6 KB · Affichages: 57
  • combinaisons.xlsm
    21.6 KB · Affichages: 53
  • combinaisons.xlsm
    21.6 KB · Affichages: 55

julien clerc

XLDnaute Junior
Re : mélanger aléatoirement des résultat

alors je n'est pas de but ultime , je veux juste mélanger toute ces combinaison afin d'éviter des colonne entière qui commence par ex : 123 ..
123....
123....

je veux que toute le tableau soit mélanger aléatoirement , je pensé que excel résoudrais cette tache facilement mais je me rent compte de la difficulté du code .. par foi les chose qui paraisse difficile se montre facile et l'inverse !
pour ton code je suis content du début les colonnes A B C D E son correctement mélanger mais la suite du tableau reste incomplète il reste des ligne contenant le même début de combinaison qui se suive :confused:



clerc,
 

Discussions similaires

Réponses
8
Affichages
615