[Résolu] Tirage aléatoire sans doublons

Lone-wolf

XLDnaute Barbatruc
Bonjour le Forum,

Un exemple parmi tant d'autres.
Dans l'exemple ce sont 6 numéros, mais vous pouvez étendre la plage à votre guise.


Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("a1")) Is Nothing Then Application.GoTo Range("a1")
Set plage = Range("e2:j2")
Randomize
For i = 5 To 10
1 alea = Int((45 * Rnd) + 1)
If Application.CountIf(plage, alea) Then GoTo 1 Else Cells(2, i) = alea
Next i
End Sub


Edit: 2ème exemple

Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("a1")) Is Nothing Then Application.GoTo Range("a1")
Set plage = Range("a5:n5")
Randomize
For i = 1 To 14
1 alea = Int((100 * Rnd) + 1)
If Application.CountIf(plage, alea) Then GoTo 1 Else Cells(5, i) = alea

'Pour vérifier si il y a des doublons
If Application.CountIf(plage, alea) > 1 Then Cells(5, i).Font.ColorIndex = 3
Next i
End Sub


Très bon weekend à tous :cool:
 
Dernière édition:

Modeste geedee

XLDnaute Barbatruc
Re : Tirage aléatoire sans doublons

Bonsour®
Bonjour à tous

Il me semble avoir vu il y a quelques années, que si on ne met pas Randomize, on n'a pas de vraies valeurs aléatoires, mais une suite toujours la même.

Mais peut-être que le dictionnaire le corrige, mais ce serait étonnant:confused:.

le probleme serait le même...

sans randomize on retrouverait souvent les mêmes dictionnaires.
avec randomize, cet inconvénient devriendrait ... heu ... comment dire ???
Aléatoire ...:rolleyes:
 

pierrejean

XLDnaute Barbatruc
Re : Tirage aléatoire sans doublons

Salut Staple :)
Salut Modeste :)

@Mj13

Pour avoir une idée du besoin de Randomize fait le test suivant avec le fichier Alea6
1) ouvre le et fait 3 essais ,note les
2) rouvre le et fait de nouveau 3 essais et compare avec les precedents
 

Pièces jointes

  • Alea6.xls
    37 KB · Affichages: 126
  • Alea6.xls
    37 KB · Affichages: 126
  • Alea6.xls
    37 KB · Affichages: 128
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re : Tirage aléatoire sans doublons

Re à tous, Bonjour Pierrejean ;)


Otez moins d'un doute.
Excel génère des nombres pseudo-aléatoires (d'où mon premier message dans ce fil)
Où ce n'est plus le cas dans les versions récentes d'Excel? (voir le lien du support Microsoft dans mon 1er message)

Sinon pour les aventureux extrêmes, Ce lien n'existe plus peut-être ? ;)
Le générateur en lui-même (celui du lien au dessus)

EDITION: Bonsoir JJ1
 
Dernière édition:
J

JJ1

Guest
Re : Tirage aléatoire sans doublons

Bonsoir à tous,

J'ai testé la macro de Pierre Jean:

Impressionnant le code Alea avec Dictionnary (que je ne connais pas ) 5000 combinaisons (avec 2 formules matricielles de calcul) en moins d'une minute !


petite question: quand Windows passe en veille prolongé, la macro continue ou s'arrête (car je laisse tourner le pc 2 ou 3 heures)? quand je reviens et bouge la souris ( ! ) je clic la session et retrouve ma macro, mais a t- elle avancé?
merci
 

david84

XLDnaute Barbatruc
Re : [Résolu] Tirage aléatoire sans doublons

Bonsoir,
Merci pour ce fichier !

Une chose cependant : si le risque d'avoir 2 valeurs identiques dans une même série est improbable, il n'est cependant statistiquement pas nul (et augmentera avec le nombre d'élément total à traiter), et donc la fonction Rang ramènerait 2 valeurs identiques : le risque de doublon n'est donc pas nul.

Pour palier cela, je verrais plutôt
Code:
=SI(LIGNE()<=E$3;RANG(A1;DECALER(A$1;0;0;E$2;1))+NB.SI(DECALER(A$1;0;0;E$2;1);A1)-1;"")
Sinon, pourquoi limiter à 99 le nombre d'éléments tirés ?
A+
Edit: sinon, pour obtenir une série aléatoire sans doublon allant de 1 à la valeur max choisie, un essai dans le fichier joint.
 

Pièces jointes

  • Tirage_aléatoire sans doublons_formule.xls
    185.5 KB · Affichages: 131
Dernière édition:

Modeste geedee

XLDnaute Barbatruc
Re : [Résolu] Tirage aléatoire sans doublons

Bonsour®
Bonsoir,

Merci pour ce fichier !
Sinon, pourquoi limiter à 99 le nombre d'éléments tirés ?

simple valeur de validation
afin de limiter la recopie de la formule RANG

mes 1er essais avaient portés sur toutes les lignes ALEA et RANG (1 048 576)
les temps de calculs étaient relativement loooooong.....:(

je ne parle même pas de la sauvegarde...:rolleyes:

puis le pire la taille...
quand je voulu mettre le classeur en pièce jointe via XLD :(

je redis donc dans ce cas précis, la suprématie de VBA pour gérer dynamiquement ces plages énormes.
 
J

JJ1

Guest
Re : Tirage aléatoire sans doublons

Bonjour le fil,

J'utilise fréquemment l'excellent code "dictionnary", très rapide de Pierre Jean.
Sub test()
Set dico = CreateObject("Scripting.dictionary")
While dico.Count < 10
x = Int((45 * Rnd) + 1)
dico(x) = x
Wend
Range("E2").Resize(, 10) = dico.keys
End Sub

le code fait un tirage de 10 nombres "aléatoires" (mais qui reviennent souvent à mon goût..bref !)

Ces 10 nombres sont rangés en $G$1:$P$1 dans une boucle.

Ensuite, par des formules de type =G$1, =H$1 ...je forme en G2:J211 les 210 combinaisons possibles des 10 nombres aléatoires situés en G$1:p$1.

Ce qui ralentit énormément le code (210*4 formules = !!)

La macro Dictionary peut-elle directement inscrire les 210 combinaisons de 4 nombres en G2:J211 en sautant la case d'inscription G$1:p$1 ?

Ce devrait être plus rapide !

merci beaucoup.

BONNE SOIREE DE REVEILLON A TOUS !!
JJ1
 

pierrejean

XLDnaute Barbatruc
Re : [Résolu] Tirage aléatoire sans doublons

Bonjour JJ1

Si tu veux bien ajoute un Randomize a la macro que tu cites:

Code:
Sub test()
Set dico = CreateObject("Scripting.dictionary")
While dico.Count < 10
Randomize
x = Int((45 * Rnd) + 1)
dico(x) = x
Wend
Range("E2").Resize(, 10) = dico.keys
End Sub

Par ailleurs vois si j'ai bien compris ton problème
 

Pièces jointes

  • JJ1_alea.xls
    53 KB · Affichages: 68
J

JJ1

Guest
Re : [Résolu] Tirage aléatoire sans doublons

Bonjour Pierre Jean et merci pour la rapidité de ta réponse.
J'ai ajouté le randomize.

Par contre, la macro modifiée "s'écroule" dès lors que je mets une formule de comptage pour la série des 210* 4 nombres, alors qu'avec les formules de renvoi type =G1,=H1....elle fonctionne.
Je ne comprends pas, je continue donc avec la précédente. (je te joins un fichier exemple pour te montrer la vitesse malgré la formule en K, la macro modifiée n'avance plus même avec une seule cellule avec une formule matricielle !)

Merci de ton aide et passe un super réveillon !!!


A 2013 !
 

Pièces jointes

  • exemple.xlsm
    50 KB · Affichages: 54
  • exemple.xlsm
    50 KB · Affichages: 51
  • exemple.xlsm
    50 KB · Affichages: 56
Dernière modification par un modérateur:

ROGER2327

XLDnaute Barbatruc
Re : [Résolu] Tirage aléatoire sans doublons

Bonjour à tous


Dans la même veine que la solution de pierrejean, sans recours à un dictionnaire et avec quelques tests en moins :​
VB:
Sub test()
Dim i&, j&, k&, l&, n&
ReDim v&(1 To 45)
ReDim z&(1 To WorksheetFunction.Combin(10, 4), 3)
    For i = 1 To UBound(v): v(i) = i: Next
    Randomize
    For i = UBound(v) To 2 Step -1
        j = v(i): v(i) = v(1 + Int(i * Rnd)): v(1 + Int(i * Rnd(0))) = j
    Next
    For i = 1 To 7
    For j = i + 1 To 8
    For k = j + 1 To 9
    For l = k + 1 To 10
        n = n + 1
        z(n, 0) = v(i)
        z(n, 1) = v(j)
        z(n, 2) = v(k)
        z(n, 3) = v(l)
    Next l, k, j, i
    Application.Calculation = xlCalculationManual
    Range("G1:P1").Value = v
    Range("G5").Resize(UBound(z, 1), 4).Value = z
    Application.Calculation = xlCalculationAutomatic
End Sub


Bonne journée.


ROGER2327
#6342


Mercredi 4 Décervelage 140 (Décervelage - fête Suprême Première seconde)
12 Nivôse An CCXXI, 3,9596h - argile
2013-W01-2T09:30:11Z
 

youky(BJ)

XLDnaute Barbatruc
Re : [Résolu] Tirage aléatoire sans doublons

Bonjour à tous,
et Bonne Année !
Je suis étonné que personne n'ai donné cette solution...
Exemple ici trier aléatoirement 100 lignes sur 100 donc sans doublons
ceci sans dico, qu'avec un tableau et pas de répétition du Rnd
Bruno

Code:
deb = 1: fin = 100
ReDim T(deb To fin)
For i = deb To fin: T(i) = i: Next i
Randomize
For i = deb To fin
    k = Int((fin - i + 1) * Rnd + i)
    my = T(i): T(i) = T(k): T(k) = my
Next i
[J1].Resize(UBound(T)) = Application.Transpose(T)
 

pierrejean

XLDnaute Barbatruc
Re : [Résolu] Tirage aléatoire sans doublons

Re

Euh.... youky(BJ)

Quel est le rapport avec le problème de JJ1 qui est de:
1) Sortir aleatoirement 10 nombres d'une serie de 45
2) ecrire les 240 combinaisons de 4 nombres pris parmi les precedents

??????
 

Discussions similaires

Réponses
1
Affichages
229

Membres actuellement en ligne

Statistiques des forums

Discussions
314 450
Messages
2 109 719
Membres
110 551
dernier inscrit
Khyolyanna