Nombre aléatoire Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
Avatar du membre
Steelson
Fanatique d'Excel
Fanatique d'Excel
Messages : 14'040
Appréciations reçues : 830
Inscrit le : 13 octobre 2014
Version d'Excel : 2013 FR
Téléchargements : Mes applications

Message par Steelson » 4 mars 2016, 15:35

Joan066 a écrit :Pourriez vous me faire un commentaire sur cette Macro , pour essayer de comprendre son fonctionnement
cordialement
Je vais tenter d'expliquer ...

Il y a 3 boucles, comme 3 poupées russes :
colonne = 1
Do
    Do
'...
        While Tirag.Count < Range("effectif")
'...
        Wend
'...
    Loop Until Range("test").Offset(0, colonne - 1) = 0
    colonne = colonne + 1
Loop Until colonne > 4

Prenons celle du milieu :
'...
        Set Tirag = CreateObject("Scripting.Dictionary")
        While Tirag.Count < Range("effectif")
            Randomize Timer
            Nbr = Int(Range("effectif") * Rnd) + 1
            Tirag(Nbr) = Nbr
        Wend
        Cells(6, colonne + 39).Resize(Tirag.Count) = Application.Transpose(Tirag.Items)
Pour chacune des 4 colonnes, nous allons faire un tirage au sort avec Randomize suivi de Rnd, le nombre Nbr qui en sort est compris entre 1 et l'effectif complet (150)
Nous allons utiliser un "dictionnaire virtuel" Tirag pour ranger ce que nous avons trouvé ... par exemple Tirage(3) a été trouvé, puis il a été trouvé une seconde fois alors il écrase le précédent ... et quand nous arrivons à ce que 150 "définitions" ont été trouvées, cela veut dire que nous avons trouvé 150 définitions différentes avec des chiffres entre 1 et 150
A ce moment c'est bon, nous avons une suite de nombres tous différents.
Application.Transpose var permettre de ranger ces valeurs dans la colonne.

Deuxième boucle :
    Do
'...
    Loop Until Range("test").Offset(0, colonne - 1) = 0
La question est : est-ce que la suite trouvée ne percute pas la précédente ? n'y a t-il pas des mêmes valeurs sur la même ligne ? Je vais donc voir la valeur des redondances (voir la formule dans excel car j'ai pris le pari d'avoir un système hybride avec du VBA et des formules de contrôle excel). S'il y a plus que zéro redondance, on recommence la première boucle uniquement opour cette nouvelle colonne jusqu'à ce qu'un tirage complet de 150 valeurs convienne ...
Tu remarqueras aussi que le test de redondances sur la première colonne est bidon puisqu'elle est seule. Mais pour la beauté du code j'ai donc forcé le test à 0 pour passer de suite à la seconde colonne.

Troisième boucle:
colonne = 1
Do
'...
    colonne = colonne + 1
Loop Until colonne > 4
On refait cela pour chacune des colonnes

et cela donne un code compact :
colonne = 1
Do
    Do
        Set Tirag = CreateObject("Scripting.Dictionary")
        While Tirag.Count < Range("effectif")
            Randomize Timer
            Nbr = Int(Range("effectif") * Rnd) + 1
            Tirag(Nbr) = Nbr
        Wend
        Cells(6, colonne + 39).Resize(Tirag.Count) = Application.Transpose(Tirag.Items)
    Loop Until Range("test").Offset(0, colonne - 1) = 0
    colonne = colonne + 1
Loop Until colonne > 4

N'oublie pas de corriger la protection qui empêche la recopie des valeurs trouvées ... et de prendre le code posté ce matin pendant la pause à 10h et des brouettes...

O.o°• ♪♪♫ °º¤ø,¸¸,ø¤º°`°º¤ø,¸ O.o°• ♪♪♫ °º¤ø,¸¸,ø¤º°`°º¤ø,¸
PI = 3.14159 26535 89793 23846 26433 83279 50288 41971 69399 37510 58209 74944 59230 78164 06286 20899 86280

( ͡• ͜ʖ ͡• )
J
Joan066
Membre habitué
Membre habitué
Messages : 66
Inscrit le : 19 février 2016
Version d'Excel : 2003

Message par Joan066 » 4 mars 2016, 17:51

bonjour , même avec ton explication j'ai du mal la suivre , mais c'est très gentil de ta part d'avoir bien décortiqué la macro.
Je suis en sur le tableau pour faire des essais à toutes les plages qui pour l'instant fonctionne .
Je tiens a te remercier de ton aide a la création de mon tableau .
cordialement
J
Joan066
Membre habitué
Membre habitué
Messages : 66
Inscrit le : 19 février 2016
Version d'Excel : 2003

Message par Joan066 » 5 mars 2016, 00:25

Bonsoir! Steelson . Je viens de passé la soirée à tout testé et miracle tout fonctionne comme souhaité. Mes connaissances en Macro sont très limité je n’aurais pas trouvé toute ces formules tout seul.
Un grand merci pour ton aide et EXCEL-PRATIQUE, sans oublier Bydaddy154. D'une petite macro faite par Amadeus ,que je remercie également, j'ai fini mon tableau . Bien sûr, il y a des formules qui qui aurait besoin de rangement ou carrément de suppression, ce n'est pas grave, il fonctionne.
Mille mercissssssssss
Cordialement Joan066
Avatar du membre
Steelson
Fanatique d'Excel
Fanatique d'Excel
Messages : 14'040
Appréciations reçues : 830
Inscrit le : 13 octobre 2014
Version d'Excel : 2013 FR
Téléchargements : Mes applications

Message par Steelson » 10 mars 2016, 06:04

Joan,

si maintenant tu ne souhaites pas avoir de doublets qui se répètent, voici la solution
Option Explicit
Sub tirage()
Dim Tirag As Object
Dim Nbr As Long
Dim colonne As Integer

    colonne = 1
    Do
        Columns([debut].Column + colonne - 1).ClearContents
        Do
            Do
                Set Tirag = CreateObject("Scripting.Dictionary")
                While Tirag.Count < [effectif]
                    Randomize Timer
                    Nbr = Int([effectif] * Rnd)
                    Tirag(Nbr) = Nbr
                Wend
                Cells([debut].Row, [debut].Column + colonne - 1).Resize(Tirag.Count) = Application.Transpose(Tirag.Items)
            Loop Until [test].Offset(0, colonne - 1) = 0
        Loop Until test_doublets(colonne)
        colonne = colonne + 1
    Loop Until colonne > 4

End Sub
Function test_doublets(col As Integer)
Dim doublette As Object
Dim compteur As Integer
Dim i As Integer, j As Integer, val As String
    compteur = 0
    Set doublette = CreateObject("Scripting.Dictionary")
    For i = [debut].Row To [debut].Row + [effectif] - 2 Step 2
        For j = [debut].Column To [debut].Column + col - 1
            val = Cells(i, j) & "|" & Cells(i + 1, j)
            doublette(val) = val
            val = Cells(i + 1, j) & "|" & Cells(i, j)
            doublette(val) = val
            compteur = compteur + 2
        Next
    Next
    test_doublets = IIf(doublette.Count = compteur, True, False)
    Cells([test].Row, [test].Column + 6).Resize(doublette.Count) = Application.Transpose(doublette.Items)
End Function
tirage 4 colonnes sans doublon.xlsm
(29.39 Kio) Téléchargé 10 fois

O.o°• ♪♪♫ °º¤ø,¸¸,ø¤º°`°º¤ø,¸ O.o°• ♪♪♫ °º¤ø,¸¸,ø¤º°`°º¤ø,¸
PI = 3.14159 26535 89793 23846 26433 83279 50288 41971 69399 37510 58209 74944 59230 78164 06286 20899 86280

( ͡• ͜ʖ ͡• )
J
Joan066
Membre habitué
Membre habitué
Messages : 66
Inscrit le : 19 février 2016
Version d'Excel : 2003

Message par Joan066 » 10 mars 2016, 11:12

bonjour Steelson, vraiment désolé de faire encore appel à ta gentillesse et ta générosité mais la nouvelle Macro ne fonctionne pas , (peut être parce que je fonctionne avec Excel 2003).
Désolé pour la protection des macros ,Je croyais avoir fini avec le tableau , Hélas :#@&: et j'ai oublier de les enlever.
Comme tu peut voir je ne suis pas doué avec Excel et les macros .
Merci de ton aide .
cordialement

http://www.cjoint.com/c/FCkkcH1jp0U
Avatar du membre
Steelson
Fanatique d'Excel
Fanatique d'Excel
Messages : 14'040
Appréciations reçues : 830
Inscrit le : 13 octobre 2014
Version d'Excel : 2013 FR
Téléchargements : Mes applications

Message par Steelson » 10 mars 2016, 13:02

Tu peux vérifier dans la feuille_test que les doublettes sont uniques.
essai-Tableau-tournante-Petanque.xls
(256 Kio) Téléchargé 14 fois

O.o°• ♪♪♫ °º¤ø,¸¸,ø¤º°`°º¤ø,¸ O.o°• ♪♪♫ °º¤ø,¸¸,ø¤º°`°º¤ø,¸
PI = 3.14159 26535 89793 23846 26433 83279 50288 41971 69399 37510 58209 74944 59230 78164 06286 20899 86280

( ͡• ͜ʖ ͡• )
J
Joan066
Membre habitué
Membre habitué
Messages : 66
Inscrit le : 19 février 2016
Version d'Excel : 2003

Message par Joan066 » 10 mars 2016, 13:42

re bonjour , le fichier "essai tableau tournante pétanque " ne s'ouvre pas .
cordialement

Attention !, sur ton tableau des nbres aléatoire il y a des zéros
, . Sur mon tableau je commence a 1 et fini a 150
Merci
Cordialement
Avatar du membre
Steelson
Fanatique d'Excel
Fanatique d'Excel
Messages : 14'040
Appréciations reçues : 830
Inscrit le : 13 octobre 2014
Version d'Excel : 2013 FR
Téléchargements : Mes applications

Message par Steelson » 10 mars 2016, 16:28

essai-Tableau-tournante-Petanque.xls
(271 Kio) Téléchargé 26 fois

O.o°• ♪♪♫ °º¤ø,¸¸,ø¤º°`°º¤ø,¸ O.o°• ♪♪♫ °º¤ø,¸¸,ø¤º°`°º¤ø,¸
PI = 3.14159 26535 89793 23846 26433 83279 50288 41971 69399 37510 58209 74944 59230 78164 06286 20899 86280

( ͡• ͜ʖ ͡• )
J
Joan066
Membre habitué
Membre habitué
Messages : 66
Inscrit le : 19 février 2016
Version d'Excel : 2003

Message par Joan066 » 10 mars 2016, 17:06

re-bonjour steelson, merci pour ta gentillesse de bien vouloirt'occuper de mon tableau .
. comment faire pour effacer et si on peut? les Nbrs à chaque tirage en fonction du nombre de participants dans la ( Feuilles_test) colonne "F", car si nous avons 150 participants (Colonne "F") dépasse les 89 lignes et arrive a 601 lignes .
A la colonne "G" je pense que je peux prolonger la colonne avec la poignet de la cellule afin de mettre la formule jusqu’à la ligne 601.
cordialement
Avatar du membre
Steelson
Fanatique d'Excel
Fanatique d'Excel
Messages : 14'040
Appréciations reçues : 830
Inscrit le : 13 octobre 2014
Version d'Excel : 2013 FR
Téléchargements : Mes applications

Message par Steelson » 10 mars 2016, 17:53

Bonsoir,

A part les 4 "0", tout ce qui est dans cette feuille est superflu.
Tu peux modifier le test comme ceci :
Function test_doublets(col As Integer)
Dim doublette As Object
Dim compteur As Integer
Dim i As Integer, j As Integer, val As String
    compteur = 0
    Set doublette = CreateObject("Scripting.Dictionary")
    For i = Range("AN6").Row To Range("AN6").Row + Range("C1") - 2 Step 2
        For j = Range("AN6").Column To Range("AN6").Column + col - 1
            val = Cells(i, j) & "|" & Cells(i + 1, j)
            doublette(val) = val
            val = Cells(i + 1, j) & "|" & Cells(i, j)
            doublette(val) = val
            compteur = compteur + 2
        Next
    Next
    test_doublets = IIf(doublette.Count = compteur, True, False)
    Sheets("Feuille_test").Range("F:F").ClearContents
    Sheets("Feuille_test").Cells(Range("test").Row, Range("test").Column + 5).Resize(doublette.Count) = Application.Transpose(doublette.Items)
End Function

j'ai juste ajouté
Sheets("Feuille_test").Range("F:F").ClearContents

oui tu peux tirer en G

O.o°• ♪♪♫ °º¤ø,¸¸,ø¤º°`°º¤ø,¸ O.o°• ♪♪♫ °º¤ø,¸¸,ø¤º°`°º¤ø,¸
PI = 3.14159 26535 89793 23846 26433 83279 50288 41971 69399 37510 58209 74944 59230 78164 06286 20899 86280

( ͡• ͜ʖ ͡• )
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message