sur une liste de 16 chiffres en sortir aleatoirement 23 ,donc il y aura des doublons

controlo · 26 Février 2012

Bonsoir à tous ,

J'ai le problème suivant à résoudre, un tableau feuil1(dans le fichier joint ) avec 16 valeurs je dois piocher au hasard dans ces 16 valeurs pour remplir le tableau en feuil2 qui lui a 23 cellules à remplir.Je sais donc que j'aurais 2 fois les mêmes valeurs.Mais l'important pour moi,c'est de ne pas avoir deux valeurs identiques consécutives (il faut que parmi les 23 valeurs les doublons soient dispèrsés.Merci de me faire une macro dans mon fichier et de la commenter de façon à ce que je comprenne.

Merci

ROGER2327 · 27 Février 2012

Re : sur une liste de 16 chiffres en sortir aleatoirement 23 ,donc il y aura des doub

Bonjour pierrejean, bonjour à tous.

pierrejean à dit:
(...)
Cette version ne donne plus que
tous les nombres de la serie de 16
et 7 doublons
(...)

Nous arrivons au but par des voies différentes.

Je me suis toutefois imposé une contrainte supplémentaire (pas prévue par notre ami) :
Si, par accident ou par pure méchanceté, la liste de départ comporte des doublons, il faut que la liste extraite respecte autant que faire se peut l'exigence d'altérité de deux éléments successifs.
Par exemple, la liste donnée étant

A A A A A A A A A A B B B B B B

(dix A et six B), on doit obtenir

A B A B A B A B A B A B A B A B A B A B A B A

ou

B A B A B A B A B A B A B A B A B A B A B A B.

Bien entendu, quoi que très bête, la machine doit se rendre compte d'une impossibilité. Par exemple, onze A et cinq B dans la liste de départ...

Comme ce problème est amusant (?) , j'ai pris la peine de corriger quelques petites conneries dans mon code (feuille Feuil2) :

VB:

Option Explicit

Private Sub CommandButton1_Click()
    Range("Plage23").Value = toto(Feuil1.Range("Plage16").Value, Me.Range("Plage23").Cells.Count)
End Sub

Function toto(plg, p&)
Dim i&, i0&, j&, k, l&, n&, x(), z()
Const borne1 = 10&, borne2 = 10000&
    n = UBound(plg)
    Randomize
    Do
        l = l + 1
        For i = n To 1 Step -1
            j = Int(n * Rnd) + 1
            k = plg(i, 1): plg(i, 1) = plg(j, 1): plg(j, 1) = k
        Next
        ReDim x(1 To p, 0)
        For i = 1 To p
            x(i, 0) = plg(1 + (i - 1) Mod n, 1)
        Next
        For i = p To 1 Step -1
            j = Int(p * Rnd) + 1
            k = x(i, 0): x(i, 0) = x(j, 0): x(j, 0) = k
        Next
        j = 0
        Do Until i = p Or j > borne1
            j = j + 1
            For i = 2 To p - 1
                If x(i, 0) = x(i - 1, 0) Then k = x(i, 0): x(i, 0) = x(i + 1, 0): x(i + 1, 0) = k: Exit For
            Next
            i = i + (x(p, 0) = x(p - 1, 0))
            If i > i0 Then i0 = i: z = x
        Loop
    Loop While j > borne1 And l < borne2
    If l = borne2 Then MsgBox "Echec !" & vbLf & vbLf & "Essayez encore !" & vbLf & Space(36) & "(...ou revoyez vos données.)"
    toto = z
End Function

Bonne soirée.

ROGER2327
#5566

Mercredi 4 Pédale 139 (Saint Michet, Idéaliste - fête Suprême Quarte)
8 Ventôse An CCXX, 6,5136h - violette
2012-W09-1T15:37:58Z

laetitia90 · 27 Février 2012

Re : sur une liste de 16 chiffres en sortir aleatoirement 23 ,donc il y aura des doub

bonjour tous 🙂🙂🙂🙂🙂🙂🙂
une autre approche un peu differente suffisant pour 23 items attention code brut un seul tableau
pas de redim ou redim preserve pour faire simple

j'utilise Dictionary, Randomize Timer
et une ligne importante qui rappel la macro en cas de suite

je repete code brut on peut simplifier les boucles mais plus le temps🙁

un peu plante dans le code il faut ecrire comme cela

Code:

Sub es()
 Dim v As Byte, i As Variant, m As Object, t As Variant
  Set m = CreateObject("Scripting.Dictionary")
  Do While m.Count < 16
   Randomize Timer
   v = Int((16 * Rnd) + 1): m(v) = v
  Loop
  t = m.items
  For i = 0 To UBound(t)
  Cells(i + 5, 3) = Cells(t(i), 1)
  Next i
  Set m = Nothing: Erase t
  Set m = CreateObject("Scripting.Dictionary")
  Do While m.Count < 7
   Randomize Timer
   v = Int((16 * Rnd) + 1): m(v) = v
  Loop
  t = m.items
  For i = 0 To UBound(t)
  Cells(i + 21, 3) = Cells(t(i), 1)
  If Cells(21, 3) = Cells(20, 3) Then es
  Next i
  Set m = Nothing: Erase t
End Sub

ps salut fo_rum🙂

Fo_rum · 27 Février 2012

Re : sur une liste de 16 chiffres en sortir aleatoirement 23 ,donc il y aura des doub

Bonsoir,

un autre essai (par permutations)

Code:

Sub Bouton1_Cliquer()
  Dim Plage, Temp
  Dim l As Byte, n As Byte
  Randomize
  Plage = Sheets("Feuil1").[A2:A17]
  'permutation aléatoire des 16 nombres
  For n = 1 To 16
    l = Int(16 * Rnd + 1)
    Temp = Plage(l, 1)
    Plage(l, 1) = Plage(n, 1)
    Plage(n, 1) = Temp
  Next
  Range("A1:A16").Value = Plage
  'tirage de 7 des nombres
  For n = 17 To 24
    l = Int(16 * Rnd + 1)
    Temp = Plage(l, 1)
    Plage(l, 1) = Plage(n - 16, 1)
    Plage(n - 16, 1) = Temp
  Next
  Range("A17:A23").Value = Plage
End Sub

ROGER2327 · 28 Février 2012

Re : sur une liste de 16 chiffres en sortir aleatoirement 23 ,donc il y aura des doub

Bonsoir à tous

Ce truc inspire, dirait-on...
Toutefois, les deux dernière propositions présentent le défaut de laisser quelquefois deux valeurs consécutives identiques. Sur une série de 5000 essais, Fo_rum renvoie 218 cas de doublon (aux lignes 16 et 17), tandis que laetitia90 renvoie 18 cas de doublon (aux lignes 17 et 18).

ROGER2327
#5572

Jeudi 5 Pédale 139 (Saint Ouducul, trouvère - fête Suprême Quarte)
9 Ventôse An CCXX, 0,1086h - marsault
2012-W09-2T00:15:39Z

Fo_rum · 28 Février 2012

Re : sur une liste de 16 chiffres en sortir aleatoirement 23 ,donc il y aura des doub

Bonjour,

De fil en fil, comme Laetitia 🙂😀 je suppose, je n'ai pas tenu compte de la consigne des 2 consécutifs différents*. Ma proposition est donc nulle et non avenue pour cette demande.Cependant j'ai eu plaisir de retrouver des visages familiers.
*Merci Roger de le souligner😉.

laetitia90 · 28 Février 2012

Re : sur une liste de 16 chiffres en sortir aleatoirement 23 ,donc il y aura des doub

bonjour tous 🙂🙂🙂🙂🙂🙂
un peu suprise je viens de tester sur 5000 boucles pas ce pb....???? cela vient t'il de office 2012 j'utilise 2007
le seul endroit c'est la ligne 20 & 21 que je corrige avec

If Cells(21, 3) = Cells(20, 3) Then es
je rappel la macro es... j'evite goto

peut mettre cette ligne juste avant le end sub
moi plus comprendre🙁🙁
je vais refaire des tests
j'ai utliser cette macro pour faire les tests

Code:

Sub esv()
 Dim c As Variant, n As Object, x as long
For x = 1 To 5000
es
Set n = CreateObject("Scripting.Dictionary")
For Each c In Range("c5:c20")
n(c.Value) = n(c.Value) + 1
Next c
[d5].Resize(n.Count, 1) = Application.Transpose(n.items)
If [d1] > 16 Then Exit Sub
Set m = Nothing
Next x
End Sub

en cell d1 formule somme d5:d20

pierrejean · 28 Février 2012

Re : sur une liste de 16 chiffres en sortir aleatoirement 23 ,donc il y aura des doub

Re

Bises Laetitia 🙂 🙂 🙂

Je viens malheureusement confirmer les dires de notre ami ROGER
Vois le fichier suivant:
En Feuil1 ta macro es fonctionne .Maintenant teste la macro essailaeti :lorsqu'elle se termine ,tu classe le resultat et la MFC concoctée par ROGER te montrera ce que je nomme triplette
Bien entendu en Feuil3 tu peux tester la macro essaipj
Pour ma part je renonce a integrer les contraintes supplementaires que le pif de ROGER a su flairer et prefere prendre la tangente (pif de grande qualité et non de grand volume)

laetitia90 · 28 Février 2012

Re : sur une liste de 16 chiffres en sortir aleatoirement 23 ,donc il y aura des doub

rebonjour tous 🙂🙂🙂🙂🙂🙂🙂🙂
bisous PierreJean😱😱😱
effectivement dans mon test je tenais pas compte des 7 derniers items qui pouvait etre en double🙁🙁
je pouvais me retrouver avec 3 doublons mea culpa
en mettant cette ligne a la fin ou surtout apres set m=nothing semble resoudre le pb...
il faut que j'affine les tests sur de plus grandes boucles si j'ai le temps

Code:

 If Cells(21, 3) = Cells(20, 3) Then es
end sub

autrement trés bien ton code (tablos) gage de rapidite sur des grandes plages
par contre le dernier post de l'ami roger pousse le concept trés loin.... trop loin pour moi en tous les cas...

ROGER2327 · 28 Février 2012

Re : sur une liste de 16 chiffres en sortir aleatoirement 23 ,donc il y aura des doub

Re...

pierrejean à dit:
Re

Bises Laetitia 🙂 🙂 🙂

Je viens malheureusement confirmer les dires de notre ami ROGER
Vois le fichier suivant:
En Feuil1 ta macro es fonctionne .Maintenant teste la macro essailaeti :lorsqu'elle se termine ,tu classe le resultat et la MFC concoctée par ROGER te montrera ce que je nomme triplette
Bien entendu en Feuil3 tu peux tester la macro essaipj
Pour ma part je renonce a integrer les contraintes supplementaires que le pif de ROGER a su flairer et prefere prendre la tangente (pif de grande qualité et non de grand volume)

D'accord, d'accord... Mais...

Un gros pif vaut-il une belle batte ?

(Douze pages au maximum, vous avez quatre heures.)

Trêve de plaisanterie... Je viens de passer pas mal de temps à comprendre que mon test est correct. Il est vrai que notre amie aime la plaisanterie : le code du message n'est pas le code du classeur.
Plaisanterie douteuse dont je me serais volontiers passé !

Bonne soirée.

ROGER2327
#5575

Jeudi 5 Pédale 139 (Saint Ouducul, trouvère - fête Suprême Quarte)
9 Ventôse An CCXX, 7,3470h - marsault
2012-W09-2T17:37:58Z

youky(BJ) · 28 Février 2012

Re : sur une liste de 16 chiffres en sortir aleatoirement 23 ,donc il y aura des doub

Bonjour à tous
PierreJean

Code:

(pif de grande qualité et non de grand volume)

Surtout..... au pied du Beaujolais, faut le préciser

Bruno

pierrejean · 28 Février 2012

Re : sur une liste de 16 chiffres en sortir aleatoirement 23 ,donc il y aura des doub

Re

Salut youki voisin 🙂

@ ROGER

Etrange ... etrange

En pratiquant le test par vos MFC je constate assez frequemment que la macro sort 8 doublons ce qui signifie a priori qu'un des 16 nombres a été oublié
Quant au devoir de vacances , je reviens un peu plus tard apres avoir demandé à la Comtesse l'autorisation de consulter son Album
PS: J'ai cru un instant etre l'auteur de la plaisanterie douteuse , rassurez moi

laetitia90 · 28 Février 2012

Re : sur une liste de 16 chiffres en sortir aleatoirement 23 ,donc il y aura des doub

rebonjour tous
roger dans ton dernier test tu reprends uniquement mon premier post
j'ai corrige a fur & a mesure

Do While m.Count < 8

devient

Do While m.Count < 7

et dans mon dernier post cette ligne pas a la fin du code
If Cells(21, 3) = Cells(20, 3) Then es
end sub

il y a peut être d'autres pb... mais cela plus important que cela marche ou marche pas... moi m'en foutre vu la tournure des évenements

par contre ce que a dit l'ami PierreJean c'est plutôt flateur non !!!!

en consequence ceci est mon dernier message.... bonne continuation a tous sur ce forum bisous a tous.. leti

mapomme · 28 Février 2012

Re : sur une liste de 16 chiffres en sortir aleatoirement 23 ,donc il y aura des doub

Bonjour Fo-rum, Laetitia, Pierrejean, Roger, Youki et à tous les autres,

Bon! Je m'y suis également attelé. Y'a pas de raison!

J'ai essayé de trouver une méthode:

qui autorise les doublons dans la liste initiale.
qui respecte les fréquences d'apparition des doublons (visible que pour des tirages 'grands' #1000)
qui interdit deux valeurs consécutives identiques.
qui permet l'apparition ou non de chaque valeur distincte de la liste initiale dans le tirage.
(ce point est le moins satisfaisant car il rassemble dans le haut du tirage les valeurs dictinctes si telle est l'option choisie)
qui ne double pas l'appel à la fonction RND.

Liste initiale colonne B, Tirage colonne G

La procédure utilise les colonnes D et E pour dresser la liste sans doublons et les nombres d'apparition de chaque valeur dans la liste initiale.
C'est la somme cumulée de ces nombres qui sert au tirage au sort (en sautant à chaque tirage le nombre d'apparition de la précédente valeur tirée afin d'éviter de la reprendre au tirage suivant)

Les colonnes I et J sont juste là pour vérification 1) calculer le nombre d'apparition de chaque valeur dans la liste du tirage 2) pour montrer (MFC) les valeurs qui n'apparaissent pas quand on a choisi la possibilité que chaque valeur distincte puisse ne pas figurer dans la liste finale.
Une MFC doit montrer deux valeurs consécutives sur le tirage (j'espère que vous n'en verrez pas!)

Si je me suis planté (et c'est fort possible) veuillez me le signaler SVP, je réouvrirai le chantier !

pierrejean · 29 Février 2012

Re : sur une liste de 16 chiffres en sortir aleatoirement 23 ,donc il y aura des doub

Re

Absolument navré de ta reaction Laeticia et j'espere que tu ne boycotes que ce fil
Je suis certain que ROGER n'a pas voulu etre mechant
Apropos, ROGER un gros Pif ou une belle Batte ne peuvent nuire à la pratique du tennis en pension
Salut mapomme (vu ton oeuvre tres rapidement et pas vraiment tout compris !!!)

mapomme · 29 Février 2012

Re : sur une liste de 16 chiffres en sortir aleatoirement 23 ,donc il y aura des doub

Bonsoir pierrejean 🙂,

et pas vraiment tout compris !!!

Et moi qui avait un effort de rédaction! Quelle honte! 😱

sur une liste de 16 chiffres en sortir aleatoirement 23 ,donc il y aura des doublons

XLDnaute Occasionnel

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Accro

Pièces jointes

XLDnaute Barbatruc

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

Nous accordons de l'importance à votre vie privée