Obtenir 5 tirages différents sans doublons

Bonjour

Ma question est dans le titre et les explications dans le fichier ci-joint

Merci pour votre aide

10test-tirage.xlsm (112.70 Ko)

Bonjour à tous !
Joco7915, je ne comprends pas lorsque vous parlez de doublons...voulez-vous dire la ligne complète pour ne pas qu'elle se répète

exemple 15 7 9 2 5 dans le carré jaune ne se répète pas dans le carré vert ?

C'est plutot dans la verticale que les chiffres ne doivent plus être ensemble

dans les différentes couleurs ex 15 11 12 6

Bonjour à tous!

Joco7915, vois si cela te convient je me sers de votre macro Tirage exécutée 5 fois et que je recopie il faudrait être vraiment malchanceux pour les tirages soient identiques.

3test-tirage.xlsm (106.19 Ko)

Merci pour ton aide

après vérification il y a des doublons

Je vais laissé tomber ,je ne pense pas que ce que je demande soit possible.

Cordialement

bonsoir,
le tirage n'est pas vraiment efficace à la fin. ceci est mieux
 Sub tirage2()

     a = Range("A2:A21").Value
     Dim res(1 To 4, 1 To 5)
     ptr = UBound(a)

     Do
          r = WorksheetFunction.RandBetween(1, ptr)
          c = ((ptr - 1) Mod 5) + 1
          l = (ptr - c) / 5 + 1
          res(l, c) = a(r, 1)
          a(r, 1) = a(ptr, 1)
          ptr = ptr - 1
     Loop While ptr >= 1

     Range("aa1").Resize(4, 5) = res

End Sub

c'est quoi un doublon, une ligne horizontale avec 5 chiffres identiques ?

20 chiffres, 5 par tirage = 15k combinations !

Bonjour à tous!

Joco7915, BsAlv,

de ce que je comprends doublon veut dire pour vous le n°1 exemple doit apparaître seulement 1 fois dans la colonne D etc...c'est un genre de sudoku que vous voulez obtenir comme résultat parce que 20 numéros en colonnes avec 4 revient à combin(20;4) soit 4845 combinaisons de 4 chiffres et combin(20;5) en ligne soit 15504 combinaisons de 5 chiffres...votre demande est sûrement faisable

Éclairez-nous sur ce que veut dire doublon pour vous Joco7915

Bonjour à tous

Ci-joint un exemple avec explication des doublons

12classeur1.xlsm (13.63 Ko)

Bonjour à tous!

Joco7915 , voir si cela vous convient, il se peut qu'il y ait des doublons en ligne mais vous avez mentionné que vous procédiez par colonne

3joco7915-ver3.xlsm (26.76 Ko)

Bonjour à tous!

Joco7915, voici ton fichier en retour aucun doublon en vertical et horizontal, peut-être pas le plus beau code de programmation mais efficace

Bonjour à tous!

Joco7915, nouvelle version un peu plus rapide et moins compliqué

Bonne journée !

Bonjour

Merci pour toutes tes tentatives.

Je crois que je me suis mal exprimé.

En fait dans chaque groupes de chiffres il doit y avoir les chiffres de 1 à 20 et il ne faut pas qu'il y aie la même combinaison verticale

dans les autres groupes .

Je pense qu'il faut mieux laisser tomber je ne pense pas que cela soit réalisable,ou si cela est réalisable ça va etre trop long a mettre en place.

Cordialement

bonjour,

25 unique combinaisons de 4 chiffres

Sub tirage_BS()
     Set dict = CreateObject("scripting.dictionary")     'cahier de brouillon

     ActiveSheet.Range("A1:G1").EntireColumn.ClearContents

     For i = 1 To 5     '5 tirages
          Randomize
          ReDim a(1 To 20, 1 To 1)     'redim array
          For j = 1 To UBound(a)
               a(j, 1) = Format(Rnd, "0.000000000000" & "|" & Format(j, "00"))     'random valeur (0>1) & valeur
          Next
          On Error Resume Next
          a1 = Application.Sort(a)     'radom sort
          On Error GoTo 0

          ptr = 1: x = 0
          Do
               x = x + 1
               ReDim q(1 To 4, 1 To 1)    'reset quartet
               For j = 1 To 4     'prenez 4 premieres valeurs
                    q(j, 1) = Format(Split(a1(j, 1), "|")(1), "00")     'seulement 2ieme partie
               Next
               q1 = Application.Sort(q)     'sortez ces 4 valeurs
               s = Join(Application.Transpose(q1), "|")     'combinatez dans un string
               b = Not dict.exists(s)     'ce quartet, est-il deja utilisé ?
               If b Then     'NON
                    dict(s) = 1     'ajouter au dictionary
                    Cells((i - 1) * 6 + 1, ptr).Resize(4).Value = q1  'copier vers feuille
                    ptr = ptr + 1
               End If
               If ptr <= 5 Then     'toutes les numeros ne sont pas encore assignées.
                    ReDim a(1 To UBound(a) + b * 4, 1 To 1)     'si quartet est assignées, 4 numberos de moins a assigner
                    For j = 1 To UBound(a)
                         a(j, 1) = Format(Rnd, "0.000000000000" & "|" & Format(Split(a1(j - b * 4, 1), "|")(1)), "00")
                    Next
                    a1 = Application.Sort(a)
               End If
          Loop While ptr <= 5 And x < 10
          On Error GoTo 0
     Next
Range("G1").Resize(dict.Count).Value = Application.Transpose(dict.keys)

End Sub

Bonjour BsAlv merci pour ton aide

Cela semble correspondre à ce que je recherche,par contre j'ai un beug dans ton code

"Erreur d'éxécution "13" Incompatibilité de type

Sur cette partie du code

q(j, 1) = Format(Split(a1(j, 1), "|")(1), "00") 'seulement 2ieme partie

re,

quel version d'excel est-ce que vous utilisez ? 2019 ne connait pas encore "application.sort", je crois.

Re bonjour

J'ai la version 2019

C'est surement pour cela que ça ne fonctionne pas

Merci pour votre temps passé

Cordialement

Rechercher des sujets similaires à "obtenir tirages differents doublons"