[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:

camarchepas

XLDnaute Barbatruc
Re : Tirage aléatoire sans doublons

Bonjour Lone-wolf,

Merci pour ce petit exercice

Pour la pluricité, une autre solution

Principales différences : Les doublons sont vérifiés en mémoire donc sur un nombre beaucoup plus élevé d'occurences sera plus rapide.
Par interrogation du dico , l'on retrouve les adresses pour les différents nombres du tirage

Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Déclaration variables et objets
 Dim Alea As Integer
 Dim Dico As Object
 Dim Cellule As Range

'Initialisation Dico et générateur aléatoire
   Set Dico = CreateObject("Scripting.Dictionary")
   Randomize

'Pour le groupe de cellules , faire varier resize pour régler de lignes et de colonnes
   For Each Cellule In Range("A4").Resize(1, 14)
 
   'boucle d'unicité
     Do
       Alea = Int((100 * Rnd) + 1)
    'jusqu'a ce que le nombre ne soit pas dans le dico
     Loop Until Not Dico.exists(Alea)

    'Transfert la valeur dans la cellule
     Cellule = Alea
    'Ajout du nombre au dico
     Dico(Alea) = Cellule.Address

   Next Cellule
End Sub
 
Dernière édition:

bof

XLDnaute Occasionnel
Re : Tirage aléatoire sans doublons

Bonjour,
Une variante originale...
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim k!, n%, Nb%, S$
Randomize
n = 30000 'maximum : 32735
For Nb = 1 To n
  S = S & ChrW(32 + Nb)
Next
Do
  Nb = Int(Rnd * Len(S) + 1)
  k = k + 1
  Cells(k, 1) = AscW(Mid(S, Nb, 1)) - 32
  S = Left$(S, Nb - 1) & Mid$(S, Nb + 1)
Loop Until S = ""
End Sub
A+
 

Lone-wolf

XLDnaute Barbatruc
Re : Tirage aléatoire sans doublons

Bonjour camarchepas, bof,

Merci à vous aussi pour ce partage. :D

@camarchepas: oui, je sais que Scripting Dictionnary est très rapide, mais comme j'ai beaucoup de mal à travailler avec, j'ai opté pour le plus simple.


Edit: c'est juste entre nous.

Comment ça ce fait, que, arrivé à la version Office 2013, Mimi n'a pas corrigé le défaut de ALEA.ENTRE.BORNES qui affiche toujours des doublons?. Ils font des tonnes de mises à jour, ils pourraient bien corriger ce problème.




A+ :cool:
 
Dernière édition:

pierrejean

XLDnaute Barbatruc
Re : Tirage aléatoire sans doublons

Bonjour à tous

Encore avec un dictionary:

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

Pièces jointes

  • Alea6.xls
    37 KB · Affichages: 342
  • Alea6.xls
    37 KB · Affichages: 353
  • Alea6.xls
    37 KB · Affichages: 397

Staple1600

XLDnaute Barbatruc
Re : Tirage aléatoire sans doublons

Bonjour à tous

Pour le fun et pour varier les plaisirs.
Code:
Private Sub a(nb&)
With [A1].Resize(nb)
    .Name = "Z"
    .FormulaR1C1 = "=RAND()"
    .Offset(, 1).FormulaR1C1 = "=MATCH(LARGE(Z,ROW()),Z,0)"
   End With
End Sub
Code:
Sub test()
a 50
End Sub

PS: Le code VBA ci-dessus c'est juste par fainéantise car on peut préférer ne pas passer par VBA et générer des nombres aléatoires (mais pas vraiment en fait, voir ce que l'on en dit sur le net) par de simples formules ;)
 

david84

XLDnaute Barbatruc
Re : Tirage aléatoire sans doublons

Bonjour,
Comment ça ce fait, que, arrivé à la version Office 2013, Mimi n'a pas corrigé le défaut de ALEA.ENTRE.BORNES qui affiche toujours des doublons?. Ils font des tonnes de mises à jour, ils pourraient bien corriger ce problème.
ALEA.ENTRE.BORNES n'a pas pour but de se préoccuper des doublons.
Le code VBA ci-dessus c'est juste par fainéantise car on peut préférer ne pas passer par VBA et générer des nombres aléatoires (mais pas vraiment en fait, voir ce que l'on en dit sur le net) par de simples formules
Que veux-tu dire ? A priori je ne vois pas où est le problème, on peut y arriver avec une colonne intermédiaire.

Sinon je ne vois pas trop a priori ce qu'apporte l'utilisation de Randomize dans ce cas précis...de plus, cela semble ralentir le code (ce qui me semble logique, même si les 2 sont très rapides).

Test sur 30000 lignes à partir de la macro de pierrejean :
- avec Randomize : vitesse de traitement entre 0,8 et 1,2 sec
- sans Randomize : vitesse de traitement autour de 0,5 sec
Code:
Sub test()
Const nb As Long = 30000
t = Timer
Set dico = CreateObject("Scripting.dictionary")
While dico.Count < nb
 'Randomize 'enlever le Rem pour tester avec Randomize
 x = Int((nb - 1 + 1) * Rnd + 1)
 dico(Int(x)) = x
Wend
Range("A1").Resize(nb) = Application.Transpose(dico.keys)
MsgBox Timer - t
End Sub
A+
 

Staple1600

XLDnaute Barbatruc
Re : Tirage aléatoire sans doublons

Re, Bonjour david84 ;)

david84
En réponse à ton questionnement précédent

Pour ce qui est de l'aléatoire

Ce lien n'existe plus
voir aussi ici

Pour la fainéantise*:
J'ai simplement voulu dire que plutôt que de mettre la formule et les explications qui vont avec dans la discussion.
J'ai mis une petite macro qui crée un exemple et évite donc de devoir saisir la formule.
J'ai voulu aussi suggérer que les fonctions natives d'Excel permettent ici de se dispenser de macros.

*: je parlais évidemment de ma propre fainéantise.
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re : Tirage aléatoire sans doublons

Re,

D'ailleurs en relisant le second lien de mon précédent message, j'ai redécouvert cet outil d'Excel:
L’utilitaire Génération de nombres aléatoires présent dans l'utilitaire d'analyse
Ce qui renforce ma conviction* de ne pas privilégier l'emploi de VBA pour une fois ;)
(*:notamment à cause des options présentes dans cet outil, mais il est vrai qu'il faut savoir le maîtriser, ce qui d'ailleurs n'est pas mon cas ;))

EDITION: Pour ceux que cela intéresse, je mets le lien vers les fichiers qui vont avec le PDF mis en lien précédemment.
(Avec notamment un exemple d'emploi de l’utilitaire Génération de nombres aléatoires )
Ces fichiers ont été réalisés par: Emmanuel GRENIER.

PS: Merci à Lone-Wolf, son fil m'aura permis de découvrir la revue MODULAD (et le site web qui s'y rattache).
Revue et site qui m'ont l'air bien intéressants.
 
Dernière édition:

MJ13

XLDnaute Barbatruc
Re : Tirage aléatoire sans doublons

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:.
 

Staple1600

XLDnaute Barbatruc
Re : Tirage aléatoire sans doublons

Re, Bonjour M13, Modeste geedee

Modeste geedee
[tentative humoristique]
cjoint, c'est un choix aléatoire ? ;)
Ou des aléas t'ont empêché de compresser ton *.xlsx pour le joindre ici même ? ;)
[/tentative humoristique]

EDITION: Pourquoi ton fichier a une taille si conséquente ??? Vu qu'il y a peu de données (de très bonne qualité cependant) dedans?
C'est encore pire lorsqu'on le transmute en *.xls (> 3.40 Mo !!! )
Bizarre, non ?

HOUPS: J'avions point vu la colonne A masquée pleine a craquer. Désolé
:p:eek:

...REHOUPS: Ni la colonne G toute aussi voluptueusement charnue

EDITION 4 ( En guise de pénitence et parce que les kilos que j'ai à perdre perturbe ma psychée un peu plus que de raison.)
Code:
Sub PardonModesteGD()
'WW's tribute
Application.ScreenUpdating = False
Columns(1).Clear
Columns(7).Clear
Range("A1:A65534").FormulaR1C1 = "=RAND()"
Range("G1:G65534").FormulaR1C1 = "=IF(ROW()<=R3C5,RANK(RC[-6],OFFSET(R1C1,0,0,R2C5,1)),"""")"
End Sub
Sur un classeur vierge en y recopiant la plage idoine et son format, en ne gardant que la feuille 1, avec cette macro non exécutée
dedans -> poids de naissance: 19ko
Après exécution de la macro, la prise de poids est spectaculaire et même le bon docteur D..kan n'y pourra rien changer.

PS: Merci en tous cas Modeste pour ces belles formules ;) et désolé pour le reste ;)
 
Dernière édition:

Modeste geedee

XLDnaute Barbatruc
Re : Tirage aléatoire sans doublons

Bonsour®
EDITION: Pourquoi ton fichier a une taille si conséquente ??? Vu qu'il y a peu de données (de très bonne qualité cependant) dedans?
C'est encore pire lorsqu'on le transmute en *.xls (> 3.40 Mo !!! )
Bizarre, non ?


Sur un classeur vierge en y recopiant la plage idoine et son format, en ne gardant que la feuille 1, avec cette macro non exécutée
dedans -> poids de naissance: 19ko
Après exécution de la macro, la prise de poids est spectaculaire et même le bon docteur D..kan n'y pourra rien changer.

c'est là que l'on retrouve l'avantage du VBA
- génération de la plage à la dimension des parametres saisis
- effacement automatique avant fermeture et sauvegarde

il n'y a pas antagonisme, mais judicieuse complémentarité (efficacité, rapidité, légéreté)
:cool:

Imagine les formules de R@chid incluses dans du VBA :eek:
 

Discussions similaires

Statistiques des forums

Discussions
311 730
Messages
2 081 981
Membres
101 855
dernier inscrit
alexis345