XL pour MAC Codes à 6 chiffres sans doublons

Artchi29 · 6 Juillet 2020

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

Dranreb · 6 Juillet 2020

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

Dranreb · 6 Juillet 2020

S'il ne doivent pas comporter de 0 il faudrait les recalculer en base 9 et ajouter 1 à chaque chiffre. (si toutefois un chiffre peut y être plusieurs fois, et à supposer que leur ordre importe).

Dranreb · 6 Juillet 2020

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

_Thierry · 6 Juillet 2020

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"...

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)

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

Bonne journée
@+Thierry

Dranreb · 6 Juillet 2020

Il n'y a pas de doublon dans les numéros engendrés, mais je me suis planté quelque part en les recalculant en base 9
À plus

Dranreb · 6 Juillet 2020

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

Dranreb · 6 Juillet 2020

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

_Thierry · 6 Juillet 2020

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

job75 · 6 Juillet 2020

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+

mapomme · 6 Juillet 2020

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

_Thierry · 6 Juillet 2020

Bravo @mapomme !

Plus long pour Excel de pointer si il y a des duplications que ta macro pour les générer !!!!

Bonne Soirée
@+Thierry

patricktoulon · 6 Juillet 2020

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

_Thierry · 6 Juillet 2020

Bravo et bonsoir aussi @patricktoulon

Encore plus rapide, et sans Doublon non plus ! Mais par contre pour respecter le sujet on n'est plus dans les clouts sur ce coup là !

Bonne soirée
@+Thierry

patricktoulon · 6 Juillet 2020

bonsoir thierry
entonnant on ne peut aller plus loin que 999999 normalement , j'ai du me planter quelque part

XL pour MAC Codes à 6 chiffres sans doublons

Artchi29

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

Pièces jointes

Dranreb

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

_Thierry

XLDnaute Barbatruc

Pièces jointes

Dranreb

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

_Thierry

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

mapomme

XLDnaute Barbatruc

Pièces jointes

_Thierry

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

_Thierry

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Discussions similaires