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

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.

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

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

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