Code aléatoire

bonjour,

sur un tuto j'ai récupéré le code en VBA pour générer des codes aléatoire (comme je voulais que 5 chiffres je l'ai adapté)

Sub code_alea()
    'www.blog-excel.com/generer-code-aleatoire
    Randomize

    carac = "123456789"
    lettre_aleatoire = ""

    For i = 1 To 5
        nombre_aleatoire = Int(Len(carac) * Rnd) + 1
        lettre_aleatoire = lettre_aleatoire & Mid(carac, nombre_aleatoire, 1)
    Next

    MsgBox lettre_aleatoire
End Sub

Sauf que je voudrais pas qu'il me sorte deux fois le même code ! Du coup dans le fichier joint j'ai mis des "noms" en feuil1 et colonne A et les codes en colonne B. Quelles lignes faut-il rajouter pour ne pour lui dire qu'il prenne en compte les codes de la colonne B ?

Francky

Bonjour

A tester

Sub code_alea()
'www.blog-excel.com/generer-code-aleatoire
  Randomize

  carac = "123456789"

  Do
    lettre_aleatoire = ""
    For i = 1 To 5
      nombre_aleatoire = Int(Len(carac) * Rnd) + 1
      lettre_aleatoire = lettre_aleatoire & Mid(carac, nombre_aleatoire, 1)
    Next
  Loop Until Application.CountIf(Columns("B"), lettre_aleatoire) = 0
  MsgBox lettre_aleatoire
End Sub

Bonjour,

Essaie ainsi :

Sub code_alea_2()
Dim Cel As Range
Dim AFaire As Long, Nb As Long, Total As Long
Dim Uniques As Object
Set Uniques = CreateObject("Scripting.Dictionary")
AFaire = Application.CountA(Columns(1)) - Application.CountA(Columns(2))
If AFaire > 0 Then
    For Each Cel In Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row)
        Uniques(Cel.Value) = Cel.Value
    Next Cel
    Total = Uniques.Count + AFaire
    Do While Uniques.Count < Total
        Randomize (Timer)
        Nb = Int(Rnd() * 89999) + 10000
        Uniques(Nb) = Nb
    Loop
End If
Range("B2").Resize(Total) = Application.Transpose(Uniques.Items)
End Sub

Bon dimanche

Salut cousinhub,

j'ai testé ton code car il met automatiquement les codes à côté des noms.

y'a un bug, j'ai effacé les nom j'en ai mis un en A2 et il bug ?

j'aimerais aussi que si il ne trouve pas de nom en colonne A qu'une Msgbox indique qu'il faut rentrer un nom en colonne A.

merci d'avance,

Francky

Re-,

y'a un bug, j'ai effacé les nom j'en ai mis un en A2 et il bug ?

As-tu également effacé les codes?

Par cette ligne :

AFaire = Application.CountA(Columns(1)) - Application.CountA(Columns(2))

Je détermine le nombre de codes à calculer

donc si tu as plus de noms que de codes, on calcule

sinon, on ne fait rien

Maintenant, calculer sans nom, je ne vois pas l'intérêt....

oui, j'avais bien effacé les codes regarde le fichier joint !

pour le nom, c'est jus si il y a quelqu'un qui oublie de rentrer un nom (bien sur que je ne veux pas de code sans nom)

merci

Francky

Re-,

Effectivement, pour le premier "Bug", je n'avais pas pris en compte l'initialisation (aucun code....)

Remplace par ceci :

Sub code_alea_2()
Dim Cel As Range
Dim AFaire As Long, Nb As Long, Total As Long
Dim Uniques As Object

Set Uniques = CreateObject("Scripting.Dictionary")
AFaire = Application.CountA(Columns(1)) - Application.CountA(Columns(2))
If AFaire > 0 Then
    If Cells(Rows.Count, 2).End(xlUp).Row > 1 Then
        For Each Cel In Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row)
            Uniques(Cel.Value) = Cel.Value
        Next Cel
    End If
    Total = Uniques.Count + AFaire
    Do While Uniques.Count < Total
        Randomize (Timer)
        Nb = Int(Rnd() * 89999) + 10000
        Uniques(Nb) = Nb
    Loop
End If
    Range("B2").Resize(Total) = Application.Transpose(Uniques.Items)
End Sub

Pour le deuxième souci, il n'y a pas de génération de code, s'il n'y a pas de nom...

Bon dimanche

Encore merci, le bug n'ai plus !

pour revenir sur mon propos, je voudrais juste éviter "l'image" jointe si on clique sur le bouton et qu'on a oublié de mettre un nom en colonne A.

Franck

re-,

effectivement.....

Déplace la ligne "Range("B2").Resize........

Juste avant le End If

Désolé...

merci ça marche impécable,

Francky