XL pour MAC Codes à 6 chiffres sans doublons

A

Artchi29

XLDnaute Nouveau
Bonjour,

Je cherche un moyen de créer une liste de 240 000 codes uniques à 6 chiffres. Les codes pouvant être composés de chiffres allant de 1 à 9.

Le but étant de mettre en place un jeu avec des codes gagnants. Aucun doublon n'est donc possible. Si vous avez des solutions je suis preneur.

Merci beaucoup,

Arthur
 
Trier par date Trier par votes
Dranreb

Dranreb

XLDnaute Barbatruc
Bonjour.
Ce classeur contient deux pièces essentielles :
1) — Une fonction personnalisée ListeAl utilisable dans une plage matricielle
2) — Un module de classe ListeAléat pour des applications plus complexes
 

Pièces jointes

  • ListeAléat.xlsm
    301.4 KB · Affichages: 12
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Avec le module de classe ListeAléat, cette procédure les produit à partir de la cellule B2 de la feuille active sur 1000 lignes et 240 colonnes :
VB: 
Option Explicit
Sub EtablirListe()
   Dim LAt As New ListeAléat, TRés(), L As Long, C As Long, NAl As Long, Num As Double
   ReDim TRés(1 To 1000, 1 To 240)
   Randomize
   LAt.Init 9 ^ 6
   For L = 1 To 1000: For C = 1 To 240
      NAl = LAt.Aléat: LAt.Supprimer NAl: NAl = NAl - 1
      Num = 0: Do: Num = Num * 10 + NAl Mod 9: NAl = NAl \ 9: Loop Until NAl = 0
      TRés(L, C) = Num + 111111
      Next C, L
   ActiveSheet.[B2].Resize(1000, 240).Value = TRés
   End Sub
 
Vote positif 0 Vote négatif
_Thierry

_Thierry

XLDnaute Barbatruc
Repose en paix
Bonjour @Artchi29 , @Dranreb

Un essai avec un code qui vient PEH sur StackOverFlow, mais mon Dieu que c'est long, mais guaranti unique 240,000 numéros à 6 digits... En colonne "A"...

1594029112027.png
soit 13 minutes ... Mais bon il écrit sur les 240k cellules !

Mais bon checké par Excel sur la Colone "A" (là aussi c'est long)
1594029119060.png


Je te laisse voir... Si ca peut convenir...

Bonne journée
@+Thierry
 

Pièces jointes

  • XLD_Artchi29_240-000_Unique_Six_Digits_Numbers.xlsm
    26.9 KB · Affichages: 7
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Là ça a l'air d'aller mieux.
Avec une seconde procédure qui les sort dans l'ordre :
VB: 
Option Explicit
Sub EtablirListe()
   Dim LAt As New ListeAléat, TRés(), L As Long, C As Long, NAl As Long, P As Long, Num As Double
   ReDim TRés(1 To 1000, 1 To 240)
   Randomize
   LAt.Init 9 ^ 6
   For L = 1 To 1000: For C = 1 To 240
      NAl = LAt.Aléat: LAt.Supprimer NAl: NAl = NAl - 1
      Num = 0: For P = 0 To 5: Num = Num + 10 ^ P * (NAl Mod 9): NAl = NAl \ 9: Next P
      TRés(L, C) = Num + 111111
      Next C, L
   ActiveSheet.[B2].Resize(1000, 240).Value = TRés
   End Sub
Sub EtablirClassée()
   Dim LAt As New ListeAléat, TAl() As Long, N As Long, P As Long, TRés(), L As Long, C As Long, NAl As Long, Num As Double
   ReDim TRés(1 To 1000, 1 To 240)
   Randomize
   LAt.Init 9 ^ 6
   LAt.ExtraireClassés TAl, 240000
   For L = 1 To 1000: For C = 1 To 240
      N = N + 1: NAl = TAl(N) - 1: Num = 0
      For P = 0 To 5: Num = Num + 10 ^ P * (NAl Mod 9): NAl = NAl \ 9: Next P
      TRés(L, C) = Num + 111111
      Next C, L
   ActiveSheet.[B2].Resize(1000, 240).Value = TRés
   End Sub
 
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Et puis zut, établissons les en String ce sera plus simple.
VB: 
Option Explicit
Sub EtablirListe()
   Dim LAt As New ListeAléat, TRés(), L As Long, C As Long, NAl As Long, P As Long, Combi As String
   ReDim TRés(1 To 1000, 1 To 240)
   Randomize
   LAt.Init 9 ^ 6
   Combi = "******"
   For L = 1 To 1000: For C = 1 To 240
      NAl = LAt.Aléat: LAt.Supprimer NAl: NAl = NAl - 1
      For P = 6 To 1 Step -1: Mid$(Combi, P, 1) = NAl Mod 9 + 1: NAl = NAl \ 9: Next P
      TRés(L, C) = Combi: Next C, L
   ActiveSheet.[B2].Resize(1000, 240).Value = TRés
   End Sub
Sub EtablirClassée()
   Dim TRés(), LAt As New ListeAléat, TAl() As Long, L As Long, C As Long, _
      N As Long, NAl As Long, Combi As String, P As Long
   ReDim TRés(1 To 1000, 1 To 240)
   Randomize
   LAt.Init 9 ^ 6
   LAt.ExtraireClassés TAl, 240000
   Combi = "******"
   For L = 1 To 1000: For C = 1 To 240
      N = N + 1: NAl = TAl(N) - 1
      For P = 6 To 1 Step -1: Mid$(Combi, P, 1) = NAl Mod 9 + 1: NAl = NAl \ 9: Next P
      TRés(L, C) = Combi: Next C, L
   ActiveSheet.[B2].Resize(1000, 240).Value = TRés
   End Sub
 
Vote positif 0 Vote négatif
_Thierry

_Thierry

XLDnaute Barbatruc
Repose en paix
WOUAOUUUH @Dranreb

Ah oui c'est immédiat ! bravo !!!

Je l'ai mis en mono colonne, nickel aussi !

VB: 
Sub EtablirClassée()
   Dim LAt As New ListeAléat, TAl() As Long, N As Long, P As Long, TRés(), L As Long, C As Long, NAl As Long, Num As Double
   ReDim TRés(1 To 240000, 1 To 1)
   Randomize
   LAt.Init 9 ^ 6
   LAt.ExtraireClassés TAl, 240000
   For L = 1 To 240000: For C = 1 To 1
      N = N + 1: NAl = TAl(N) - 1: Num = 0
      For P = 0 To 5: Num = Num + 10 ^ P * (NAl Mod 9): NAl = NAl \ 9: Next P
      TRés(L, C) = Num + 111111
      Next C, L
   ActiveSheet.[B2].Resize(240000, 1).Value = TRés
End Sub

Bien à toi, à vous
@+Thierry
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour Artchi29, Bernard, _Thierry,

Une solution beaucoup moins sophistiquée mais très facile à comprendre :
VB: 
Private Sub CommandButton1_Click()
Dim t, tablo, a, b, c, d, e, f, n&
t = Timer
ReDim tablo(1 To 9 ^ 6, 1 To 1)
For a = 1 To 9
    For b = 1 To 9
        For c = 1 To 9
            For d = 1 To 9
                For e = 1 To 9
                    For f = 1 To 9
                        n = n + 1
                        tablo(n, 1) = a & b & c & d & e & f
Next f, e, d, c, b, a
'---restitution---
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] '1ère cellule de destination, à adapter
    .Resize(n) = tablo
    .Offset(, 1).Resize(n) = "=RAND()" '=ALEA()
    .Offset(, 1).Resize(n) = .Offset(, 1).Resize(n).Value
    .Resize(n, 2).Sort .Offset(, 1), Header:=xlNo 'tri aleéatoire
    .Offset(, 1).EntireColumn.ClearContents
    .Offset(240000).Resize(Rows.Count - 240000 - .Row + 1).ClearContents '240000 gardés
End With
With UsedRange: End With 'actualise la barre de défilement verticale
Application.ScreenUpdating = True
MsgBox "Liste établie en " & Format(Timer - t, "0.00 \s")
End Sub
Fichier joint, la macro s'exécute chez moi en 2,5 secondes.

Notez qu'il serait aussi simple de garder les 531441 (9 ^ 6) éléments de la liste.

A+
 

Pièces jointes

  • Liste(1).xlsm
    22.9 KB · Affichages: 13
Vote positif 0 Vote négatif
mapomme

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonsoir à tous :)

Une autre procédure très rapide aussi (environ 0,6 sec.).
Le code est dans le module de la feuille "Feuil1" :
VB: 
Sub ListeAlea2400000()
Dim t, i&, n&, t0, m&, x&
   t0 = Timer: Randomize
   ReDim t(1 To 9 ^ 6, 1 To 1)
   For i = 111111 To 999999
      If InStr(i, 0) = 0 Then n = n + 1: t(n, 1) = i
   Next i
   For i = 1 To n
      m = Int(n * Rnd) + 1: x = t(i, 1): t(i, 1) = t(m, 1): t(m, 1) = x
   Next i
   Application.ScreenUpdating = False
   Range("a2:a" & Rows.Count).ClearContents
   Range("a2").Resize(240000) = t
   MsgBox "Liste établie en " & Format(Timer - t0, "0.00 \s"), vbInformation
End Sub
 

Pièces jointes

  • Artchi29- Liste- v1.xlsm
    18.2 KB · Affichages: 16
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
bonsoir a tous
c'est un peu moins élaguant mais
les uniques sont garantis
aucun numéro se suivent a moins de (max nombre à 6 chiffres - min nombre à 6 chiffres)/ par le nombre d'items demandé
et pour finir je fout le boxon dans l'ordre
le tout dans une colonne
et instantané
;)
VB: 
Sub textx()
   Dim Serie
   Serie = getSerie(240000, 6, True)
    Cells(1, 1).Resize(240000, 1).Value = Serie
End Sub
Function getSerie(nb&, maxChiffre&, Optional desordre As Boolean = False)
    Dim i&, c&, x&, z&, q&, valoche&
  ReDim tbl(1 To nb, 1 To 1)
    x = Val(Mid("111111111111111", 1, Abs(maxChiffre&)))
    z = Val(Mid("999999999999999", 1, Abs(maxChiffre&)))
    q = Round((z - x) / nb, 0): q = IIf(q < 1, 1, q)
    For i = 1 To nb
        x = x + Abs(q)
        tbl(i, 1) = x
    Next
    If desordre Then
        For i = 1 To nb / 2
            x = Round(1 + (Rnd * nb - 1))
            valoche = tbl(x, 1): tbl(x, 1) = tbl(i, 1): tbl(i, 1) = valoche
        Next
    End If
    getSerie = tbl
End Function
 
Vote positif 0 Vote négatif

Discussions similaires

Y
  • Question
XL 2016 Mise en forme conditionnelle [VBA] / [Formule]
Réponses
5
Affichages
1 K
Staple1600
Staple1600
F
  • Question
Ce projet est-il faisable sous excel ? (+ Recherche sous-traitants)
Réponses
7
Affichages
1 K
french50
F
E
  • Question
Générer aléatoirement des noms sans doublons
Réponses
10
Affichages
2 K
etranger6
E
M
[REF] Wiki 6 de MichelXld (Doublons, Tris, Filtres, Variables, Fichiers fermés, Acces
Réponses
0
Affichages
68 K
MichelXld
M
M
[REF] Wiki 5 de MichelXld (Formules, Audits de formules, Répertoires, Fichiers)
Réponses
0
Affichages
47 K
MichelXld
M
M
[REF] Wiki Page 8 de MichelXld
Réponses
0
Affichages
38 K
MichelXld
M

Membres actuellement en ligne

8 membres et 93 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 761
Messages
2 112 589
Membres
111 612
dernier inscrit
Maxence30