Bonjour
j'ai besoins de pouvoir générer des clés uniques pour faire des c oupons de
distribution (je travaille dans l'humanitaire)
je voudrais donc avec tout les lettres de l'alphabet et les 10 chiffres
mélangés au hasard et si possible que la chaine de charactere gén érée soit
unique
Si possible j'aimerais aussi avoir la possibilité de définir la lon gueur de
la clé et quelles caractères je désire utiliser (par exemple 0 et O étant
similaire, pouvoir enlever l'un des deux. le resultat devrais etre sous form
d'un tableaud'une colonne et d'un grand nombre de ligne (pour faire un merge
avec word et produire les coupons en PDF pour l'imprimeur)
J'avais ca l'année dernière mais j'ai perdue la feuille Excel :(
Amitiés
Thierry
Bonjour
j'ai besoins de pouvoir générer des clés uniques pour faire des c oupons de
distribution (je travaille dans l'humanitaire)
je voudrais donc avec tout les lettres de l'alphabet et les 10 chiffres
mélangés au hasard et si possible que la chaine de charactere gén érée soit
unique
Si possible j'aimerais aussi avoir la possibilité de définir la lon gueur de
la clé et quelles caractères je désire utiliser (par exemple 0 et O étant
similaire, pouvoir enlever l'un des deux. le resultat devrais etre sous form
d'un tableaud'une colonne et d'un grand nombre de ligne (pour faire un merge
avec word et produire les coupons en PDF pour l'imprimeur)
J'avais ca l'année dernière mais j'ai perdue la feuille Excel :(
Amitiés
Thierry
Bonjour
j'ai besoins de pouvoir générer des clés uniques pour faire des c oupons de
distribution (je travaille dans l'humanitaire)
je voudrais donc avec tout les lettres de l'alphabet et les 10 chiffres
mélangés au hasard et si possible que la chaine de charactere gén érée soit
unique
Si possible j'aimerais aussi avoir la possibilité de définir la lon gueur de
la clé et quelles caractères je désire utiliser (par exemple 0 et O étant
similaire, pouvoir enlever l'un des deux. le resultat devrais etre sous form
d'un tableaud'une colonne et d'un grand nombre de ligne (pour faire un merge
avec word et produire les coupons en PDF pour l'imprimeur)
J'avais ca l'année dernière mais j'ai perdue la feuille Excel :(
Amitiés
Thierry
Bonjour Thierry,
Il ne te reste plus qu'à définir les variables selon tes besoins :
'---------------------------------------------------------
Sub Chaine_Caracteres_au_hasard()
Dim A As Long, B As Long, I As Long, X As Integer
Dim Arr(), N As Long, NbCar As Integer
Dim D As Object, Texte As String
Dim NomFeuille As String, Adr As String
'Liste des caractères possible :
Arr = Array("A", "B", "C", "D", "E", "F", "G", "H", _
"I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", _
"S", "T", "U", "V", "W", "X", "Y", "Z", 0, 1, 2, _
3, 4, 5, 6, 7, 8, 9)
'********* Variables à renseigner **************
NbCar = 10 'Nombre de caractères par chaîne
N = 1000 'Nombre de chaînes différentes
'que la procédure doit générer
NomFeuille = "Feuil1" ' nom de l'onglet de la feuille
'où la liste sera inscrite
Adr = "A1" ' Adresse de la première cellule
' où débutera la liste
'***************************************************
I = 0
Set D = CreateObject("Scripting.Dictionary")
Do Until I = N
For X = 1 To NbCar
Randomize
Texte = Texte & Arr(Int((UBound(Arr) - _
LBound(Arr) + 1) * Rnd + LBound(Arr)))
Next
If Not D.Exists(Texte) Then
D.Add Texte, Texte
I = I + 1
End If
Texte = ""
Loop
With Sheets(NomFeuille)
.Range(Adr).NumberFormat = "@"
.Range(Adr).Resize(N) = Application.Transpose(D.Items)
End With
End Sub
'---------------------------------------------------------
"Thierry Schweitzer" a écrit dans le message
de groupe de discussion :
Bonjour
j'ai besoins de pouvoir générer des clés uniques pour faire des coupons de
distribution (je travaille dans l'humanitaire)
je voudrais donc avec tout les lettres de l'alphabet et les 10 chiffres
mélangés au hasard et si possible que la chaine de charactere générée soit
unique
Si possible j'aimerais aussi avoir la possibilité de définir la longueur de
la clé et quelles caractères je désire utiliser (par exemple 0 et O étant
similaire, pouvoir enlever l'un des deux. le resultat devrais etre sous form
d'un tableaud'une colonne et d'un grand nombre de ligne (pour faire un merge
avec word et produire les coupons en PDF pour l'imprimeur)
J'avais ca l'année dernière mais j'ai perdue la feuille Excel :(
Amitiés
Thierry
Bonjour Thierry,
Il ne te reste plus qu'à définir les variables selon tes besoins :
'---------------------------------------------------------
Sub Chaine_Caracteres_au_hasard()
Dim A As Long, B As Long, I As Long, X As Integer
Dim Arr(), N As Long, NbCar As Integer
Dim D As Object, Texte As String
Dim NomFeuille As String, Adr As String
'Liste des caractères possible :
Arr = Array("A", "B", "C", "D", "E", "F", "G", "H", _
"I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", _
"S", "T", "U", "V", "W", "X", "Y", "Z", 0, 1, 2, _
3, 4, 5, 6, 7, 8, 9)
'********* Variables à renseigner **************
NbCar = 10 'Nombre de caractères par chaîne
N = 1000 'Nombre de chaînes différentes
'que la procédure doit générer
NomFeuille = "Feuil1" ' nom de l'onglet de la feuille
'où la liste sera inscrite
Adr = "A1" ' Adresse de la première cellule
' où débutera la liste
'***************************************************
I = 0
Set D = CreateObject("Scripting.Dictionary")
Do Until I = N
For X = 1 To NbCar
Randomize
Texte = Texte & Arr(Int((UBound(Arr) - _
LBound(Arr) + 1) * Rnd + LBound(Arr)))
Next
If Not D.Exists(Texte) Then
D.Add Texte, Texte
I = I + 1
End If
Texte = ""
Loop
With Sheets(NomFeuille)
.Range(Adr).NumberFormat = "@"
.Range(Adr).Resize(N) = Application.Transpose(D.Items)
End With
End Sub
'---------------------------------------------------------
"Thierry Schweitzer" <thierry.schweitzer@gmail.com> a écrit dans le message
de groupe de discussion : e5WjcpetJHA.4980@TK2MSFTNGP02.phx.gbl...
Bonjour
j'ai besoins de pouvoir générer des clés uniques pour faire des coupons de
distribution (je travaille dans l'humanitaire)
je voudrais donc avec tout les lettres de l'alphabet et les 10 chiffres
mélangés au hasard et si possible que la chaine de charactere générée soit
unique
Si possible j'aimerais aussi avoir la possibilité de définir la longueur de
la clé et quelles caractères je désire utiliser (par exemple 0 et O étant
similaire, pouvoir enlever l'un des deux. le resultat devrais etre sous form
d'un tableaud'une colonne et d'un grand nombre de ligne (pour faire un merge
avec word et produire les coupons en PDF pour l'imprimeur)
J'avais ca l'année dernière mais j'ai perdue la feuille Excel :(
Amitiés
Thierry
Bonjour Thierry,
Il ne te reste plus qu'à définir les variables selon tes besoins :
'---------------------------------------------------------
Sub Chaine_Caracteres_au_hasard()
Dim A As Long, B As Long, I As Long, X As Integer
Dim Arr(), N As Long, NbCar As Integer
Dim D As Object, Texte As String
Dim NomFeuille As String, Adr As String
'Liste des caractères possible :
Arr = Array("A", "B", "C", "D", "E", "F", "G", "H", _
"I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", _
"S", "T", "U", "V", "W", "X", "Y", "Z", 0, 1, 2, _
3, 4, 5, 6, 7, 8, 9)
'********* Variables à renseigner **************
NbCar = 10 'Nombre de caractères par chaîne
N = 1000 'Nombre de chaînes différentes
'que la procédure doit générer
NomFeuille = "Feuil1" ' nom de l'onglet de la feuille
'où la liste sera inscrite
Adr = "A1" ' Adresse de la première cellule
' où débutera la liste
'***************************************************
I = 0
Set D = CreateObject("Scripting.Dictionary")
Do Until I = N
For X = 1 To NbCar
Randomize
Texte = Texte & Arr(Int((UBound(Arr) - _
LBound(Arr) + 1) * Rnd + LBound(Arr)))
Next
If Not D.Exists(Texte) Then
D.Add Texte, Texte
I = I + 1
End If
Texte = ""
Loop
With Sheets(NomFeuille)
.Range(Adr).NumberFormat = "@"
.Range(Adr).Resize(N) = Application.Transpose(D.Items)
End With
End Sub
'---------------------------------------------------------
"Thierry Schweitzer" a écrit dans le message
de groupe de discussion :
Bonjour
j'ai besoins de pouvoir générer des clés uniques pour faire des coupons de
distribution (je travaille dans l'humanitaire)
je voudrais donc avec tout les lettres de l'alphabet et les 10 chiffres
mélangés au hasard et si possible que la chaine de charactere générée soit
unique
Si possible j'aimerais aussi avoir la possibilité de définir la longueur de
la clé et quelles caractères je désire utiliser (par exemple 0 et O étant
similaire, pouvoir enlever l'un des deux. le resultat devrais etre sous form
d'un tableaud'une colonne et d'un grand nombre de ligne (pour faire un merge
avec word et produire les coupons en PDF pour l'imprimeur)
J'avais ca l'année dernière mais j'ai perdue la feuille Excel :(
Amitiés
Thierry
Chapeau ! quel savoir LIVRESQUE ;-)))
DanielBonjour Thierry,
Il ne te reste plus qu'à définir les variables selon tes besoins :
'---------------------------------------------------------
Sub Chaine_Caracteres_au_hasard()
Dim A As Long, B As Long, I As Long, X As Integer
Dim Arr(), N As Long, NbCar As Integer
Dim D As Object, Texte As String
Dim NomFeuille As String, Adr As String
'Liste des caractères possible :
Arr = Array("A", "B", "C", "D", "E", "F", "G", "H", _
"I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", _
"S", "T", "U", "V", "W", "X", "Y", "Z", 0, 1, 2, _
3, 4, 5, 6, 7, 8, 9)
'********* Variables à renseigner **************
NbCar = 10 'Nombre de caractères par chaîne
N = 1000 'Nombre de chaînes différentes
'que la procédure doit générer
NomFeuille = "Feuil1" ' nom de l'onglet de la feuille
'où la liste sera inscrite
Adr = "A1" ' Adresse de la première cellule
' où débutera la liste
'***************************************************
I = 0
Set D = CreateObject("Scripting.Dictionary")
Do Until I = N
For X = 1 To NbCar
Randomize
Texte = Texte & Arr(Int((UBound(Arr) - _
LBound(Arr) + 1) * Rnd + LBound(Arr)))
Next
If Not D.Exists(Texte) Then
D.Add Texte, Texte
I = I + 1
End If
Texte = ""
Loop
With Sheets(NomFeuille)
.Range(Adr).NumberFormat = "@"
.Range(Adr).Resize(N) = Application.Transpose(D.Items)
End With
End Sub
'---------------------------------------------------------
"Thierry Schweitzer" a écrit dans le
message de groupe de discussion :
Bonjour
j'ai besoins de pouvoir générer des clés uniques pour faire des coupons
de
distribution (je travaille dans l'humanitaire)
je voudrais donc avec tout les lettres de l'alphabet et les 10 chiffres
mélangés au hasard et si possible que la chaine de charactere générée
soit
unique
Si possible j'aimerais aussi avoir la possibilité de définir la longueur
de
la clé et quelles caractères je désire utiliser (par exemple 0 et O étant
similaire, pouvoir enlever l'un des deux. le resultat devrais etre sous
form
d'un tableaud'une colonne et d'un grand nombre de ligne (pour faire un
merge
avec word et produire les coupons en PDF pour l'imprimeur)
J'avais ca l'année dernière mais j'ai perdue la feuille Excel :(
Amitiés
Thierry
Chapeau ! quel savoir LIVRESQUE ;-)))
Daniel
Bonjour Thierry,
Il ne te reste plus qu'à définir les variables selon tes besoins :
'---------------------------------------------------------
Sub Chaine_Caracteres_au_hasard()
Dim A As Long, B As Long, I As Long, X As Integer
Dim Arr(), N As Long, NbCar As Integer
Dim D As Object, Texte As String
Dim NomFeuille As String, Adr As String
'Liste des caractères possible :
Arr = Array("A", "B", "C", "D", "E", "F", "G", "H", _
"I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", _
"S", "T", "U", "V", "W", "X", "Y", "Z", 0, 1, 2, _
3, 4, 5, 6, 7, 8, 9)
'********* Variables à renseigner **************
NbCar = 10 'Nombre de caractères par chaîne
N = 1000 'Nombre de chaînes différentes
'que la procédure doit générer
NomFeuille = "Feuil1" ' nom de l'onglet de la feuille
'où la liste sera inscrite
Adr = "A1" ' Adresse de la première cellule
' où débutera la liste
'***************************************************
I = 0
Set D = CreateObject("Scripting.Dictionary")
Do Until I = N
For X = 1 To NbCar
Randomize
Texte = Texte & Arr(Int((UBound(Arr) - _
LBound(Arr) + 1) * Rnd + LBound(Arr)))
Next
If Not D.Exists(Texte) Then
D.Add Texte, Texte
I = I + 1
End If
Texte = ""
Loop
With Sheets(NomFeuille)
.Range(Adr).NumberFormat = "@"
.Range(Adr).Resize(N) = Application.Transpose(D.Items)
End With
End Sub
'---------------------------------------------------------
"Thierry Schweitzer" <thierry.schweitzer@gmail.com> a écrit dans le
message de groupe de discussion :
e5WjcpetJHA.4980@TK2MSFTNGP02.phx.gbl...
Bonjour
j'ai besoins de pouvoir générer des clés uniques pour faire des coupons
de
distribution (je travaille dans l'humanitaire)
je voudrais donc avec tout les lettres de l'alphabet et les 10 chiffres
mélangés au hasard et si possible que la chaine de charactere générée
soit
unique
Si possible j'aimerais aussi avoir la possibilité de définir la longueur
de
la clé et quelles caractères je désire utiliser (par exemple 0 et O étant
similaire, pouvoir enlever l'un des deux. le resultat devrais etre sous
form
d'un tableaud'une colonne et d'un grand nombre de ligne (pour faire un
merge
avec word et produire les coupons en PDF pour l'imprimeur)
J'avais ca l'année dernière mais j'ai perdue la feuille Excel :(
Amitiés
Thierry
Chapeau ! quel savoir LIVRESQUE ;-)))
DanielBonjour Thierry,
Il ne te reste plus qu'à définir les variables selon tes besoins :
'---------------------------------------------------------
Sub Chaine_Caracteres_au_hasard()
Dim A As Long, B As Long, I As Long, X As Integer
Dim Arr(), N As Long, NbCar As Integer
Dim D As Object, Texte As String
Dim NomFeuille As String, Adr As String
'Liste des caractères possible :
Arr = Array("A", "B", "C", "D", "E", "F", "G", "H", _
"I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", _
"S", "T", "U", "V", "W", "X", "Y", "Z", 0, 1, 2, _
3, 4, 5, 6, 7, 8, 9)
'********* Variables à renseigner **************
NbCar = 10 'Nombre de caractères par chaîne
N = 1000 'Nombre de chaînes différentes
'que la procédure doit générer
NomFeuille = "Feuil1" ' nom de l'onglet de la feuille
'où la liste sera inscrite
Adr = "A1" ' Adresse de la première cellule
' où débutera la liste
'***************************************************
I = 0
Set D = CreateObject("Scripting.Dictionary")
Do Until I = N
For X = 1 To NbCar
Randomize
Texte = Texte & Arr(Int((UBound(Arr) - _
LBound(Arr) + 1) * Rnd + LBound(Arr)))
Next
If Not D.Exists(Texte) Then
D.Add Texte, Texte
I = I + 1
End If
Texte = ""
Loop
With Sheets(NomFeuille)
.Range(Adr).NumberFormat = "@"
.Range(Adr).Resize(N) = Application.Transpose(D.Items)
End With
End Sub
'---------------------------------------------------------
"Thierry Schweitzer" a écrit dans le
message de groupe de discussion :
Bonjour
j'ai besoins de pouvoir générer des clés uniques pour faire des coupons
de
distribution (je travaille dans l'humanitaire)
je voudrais donc avec tout les lettres de l'alphabet et les 10 chiffres
mélangés au hasard et si possible que la chaine de charactere générée
soit
unique
Si possible j'aimerais aussi avoir la possibilité de définir la longueur
de
la clé et quelles caractères je désire utiliser (par exemple 0 et O étant
similaire, pouvoir enlever l'un des deux. le resultat devrais etre sous
form
d'un tableaud'une colonne et d'un grand nombre de ligne (pour faire un
merge
avec word et produire les coupons en PDF pour l'imprimeur)
J'avais ca l'année dernière mais j'ai perdue la feuille Excel :(
Amitiés
Thierry
Bonjour Thierry,
Il ne te reste plus qu'à définir les variables selon tes besoins :
'---------------------------------------------------------
Sub Chaine_Caracteres_au_hasard()
Dim A As Long, B As Long, I As Long, X As Integer
Dim Arr(), N As Long, NbCar As Integer
Dim D As Object, Texte As String
Dim NomFeuille As String, Adr As String
'Liste des caractères possible :
Arr = Array("A", "B", "C", "D", "E", "F", "G", "H", _
"I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", _
"S", "T", "U", "V", "W", "X", "Y", "Z", 0, 1, 2, _
3, 4, 5, 6, 7, 8, 9)
'********* Variables à renseigner **************
NbCar = 10 'Nombre de caractères par chaîne
N = 1000 'Nombre de chaînes différentes
'que la procédure doit générer
NomFeuille = "Feuil1" ' nom de l'onglet de la feuille
'où la liste sera inscrite
Adr = "A1" ' Adresse de la première cellule
' où débutera la liste
'***************************************************
I = 0
Set D = CreateObject("Scripting.Dictionary")
Do Until I = N
For X = 1 To NbCar
Randomize
Texte = Texte & Arr(Int((UBound(Arr) - _
LBound(Arr) + 1) * Rnd + LBound(Arr)))
Next
If Not D.Exists(Texte) Then
D.Add Texte, Texte
I = I + 1
End If
Texte = ""
Loop
With Sheets(NomFeuille)
.Range(Adr).NumberFormat = "@"
.Range(Adr).Resize(N) = Application.Transpose(D.Items)
End With
End Sub
'---------------------------------------------------------
"Thierry Schweitzer" a écrit dans le
message de groupe de
discussion :
Bonjour
j'ai besoins de pouvoir générer des clés uniques pour faire des coupons de
distribution (je travaille dans l'humanitaire)
je voudrais donc avec tout les lettres de l'alphabet et les 10 chiffres
mélangés au hasard et si possible que la chaine de charactere générée soit
unique
Si possible j'aimerais aussi avoir la possibilité de définir la longueur
de
la clé et quelles caractères je désire utiliser (par exemple 0 et O étant
similaire, pouvoir enlever l'un des deux. le resultat devrais etre sous
form
d'un tableaud'une colonne et d'un grand nombre de ligne (pour faire un
merge
avec word et produire les coupons en PDF pour l'imprimeur)
J'avais ca l'année dernière mais j'ai perdue la feuille Excel :(
Amitiés
Thierry
Bonjour Thierry,
Il ne te reste plus qu'à définir les variables selon tes besoins :
'---------------------------------------------------------
Sub Chaine_Caracteres_au_hasard()
Dim A As Long, B As Long, I As Long, X As Integer
Dim Arr(), N As Long, NbCar As Integer
Dim D As Object, Texte As String
Dim NomFeuille As String, Adr As String
'Liste des caractères possible :
Arr = Array("A", "B", "C", "D", "E", "F", "G", "H", _
"I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", _
"S", "T", "U", "V", "W", "X", "Y", "Z", 0, 1, 2, _
3, 4, 5, 6, 7, 8, 9)
'********* Variables à renseigner **************
NbCar = 10 'Nombre de caractères par chaîne
N = 1000 'Nombre de chaînes différentes
'que la procédure doit générer
NomFeuille = "Feuil1" ' nom de l'onglet de la feuille
'où la liste sera inscrite
Adr = "A1" ' Adresse de la première cellule
' où débutera la liste
'***************************************************
I = 0
Set D = CreateObject("Scripting.Dictionary")
Do Until I = N
For X = 1 To NbCar
Randomize
Texte = Texte & Arr(Int((UBound(Arr) - _
LBound(Arr) + 1) * Rnd + LBound(Arr)))
Next
If Not D.Exists(Texte) Then
D.Add Texte, Texte
I = I + 1
End If
Texte = ""
Loop
With Sheets(NomFeuille)
.Range(Adr).NumberFormat = "@"
.Range(Adr).Resize(N) = Application.Transpose(D.Items)
End With
End Sub
'---------------------------------------------------------
"Thierry Schweitzer" <thierry.schweitzer@gmail.com> a écrit dans le
message de groupe de
discussion : e5WjcpetJHA.4980@TK2MSFTNGP02.phx.gbl...
Bonjour
j'ai besoins de pouvoir générer des clés uniques pour faire des coupons de
distribution (je travaille dans l'humanitaire)
je voudrais donc avec tout les lettres de l'alphabet et les 10 chiffres
mélangés au hasard et si possible que la chaine de charactere générée soit
unique
Si possible j'aimerais aussi avoir la possibilité de définir la longueur
de
la clé et quelles caractères je désire utiliser (par exemple 0 et O étant
similaire, pouvoir enlever l'un des deux. le resultat devrais etre sous
form
d'un tableaud'une colonne et d'un grand nombre de ligne (pour faire un
merge
avec word et produire les coupons en PDF pour l'imprimeur)
J'avais ca l'année dernière mais j'ai perdue la feuille Excel :(
Amitiés
Thierry
Bonjour Thierry,
Il ne te reste plus qu'à définir les variables selon tes besoins :
'---------------------------------------------------------
Sub Chaine_Caracteres_au_hasard()
Dim A As Long, B As Long, I As Long, X As Integer
Dim Arr(), N As Long, NbCar As Integer
Dim D As Object, Texte As String
Dim NomFeuille As String, Adr As String
'Liste des caractères possible :
Arr = Array("A", "B", "C", "D", "E", "F", "G", "H", _
"I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", _
"S", "T", "U", "V", "W", "X", "Y", "Z", 0, 1, 2, _
3, 4, 5, 6, 7, 8, 9)
'********* Variables à renseigner **************
NbCar = 10 'Nombre de caractères par chaîne
N = 1000 'Nombre de chaînes différentes
'que la procédure doit générer
NomFeuille = "Feuil1" ' nom de l'onglet de la feuille
'où la liste sera inscrite
Adr = "A1" ' Adresse de la première cellule
' où débutera la liste
'***************************************************
I = 0
Set D = CreateObject("Scripting.Dictionary")
Do Until I = N
For X = 1 To NbCar
Randomize
Texte = Texte & Arr(Int((UBound(Arr) - _
LBound(Arr) + 1) * Rnd + LBound(Arr)))
Next
If Not D.Exists(Texte) Then
D.Add Texte, Texte
I = I + 1
End If
Texte = ""
Loop
With Sheets(NomFeuille)
.Range(Adr).NumberFormat = "@"
.Range(Adr).Resize(N) = Application.Transpose(D.Items)
End With
End Sub
'---------------------------------------------------------
"Thierry Schweitzer" a écrit dans le
message de groupe de
discussion :
Bonjour
j'ai besoins de pouvoir générer des clés uniques pour faire des coupons de
distribution (je travaille dans l'humanitaire)
je voudrais donc avec tout les lettres de l'alphabet et les 10 chiffres
mélangés au hasard et si possible que la chaine de charactere générée soit
unique
Si possible j'aimerais aussi avoir la possibilité de définir la longueur
de
la clé et quelles caractères je désire utiliser (par exemple 0 et O étant
similaire, pouvoir enlever l'un des deux. le resultat devrais etre sous
form
d'un tableaud'une colonne et d'un grand nombre de ligne (pour faire un
merge
avec word et produire les coupons en PDF pour l'imprimeur)
J'avais ca l'année dernière mais j'ai perdue la feuille Excel :(
Amitiés
Thierry
Bonjour Thierry,
Il ne te reste plus qu'à définir les variables selon tes besoins :
'---------------------------------------------------------
Sub Chaine_Caracteres_au_hasard()
Dim A As Long, B As Long, I As Long, X As Integer
Dim Arr(), N As Long, NbCar As Integer
Dim D As Object, Texte As String
Dim NomFeuille As String, Adr As String
'Liste des caractères possible :
Arr = Array("A", "B", "C", "D", "E", "F", "G", "H", _
"I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", _
"S", "T", "U", "V", "W", "X", "Y", "Z", 0, 1, 2, _
3, 4, 5, 6, 7, 8, 9)
'********* Variables à renseigner **************
NbCar = 10 'Nombre de caractères par chaîne
N = 1000 'Nombre de chaînes différentes
'que la procédure doit générer
NomFeuille = "Feuil1" ' nom de l'onglet de la feuille
'où la liste sera inscrite
Adr = "A1" ' Adresse de la première cellule
' où débutera la liste
'***************************************************
I = 0
Set D = CreateObject("Scripting.Dictionary")
Do Until I = N
For X = 1 To NbCar
Randomize
Texte = Texte & Arr(Int((UBound(Arr) - _
LBound(Arr) + 1) * Rnd + LBound(Arr)))
Next
If Not D.Exists(Texte) Then
D.Add Texte, Texte
I = I + 1
End If
Texte = ""
Loop
With Sheets(NomFeuille)
.Range(Adr).NumberFormat = "@"
.Range(Adr).Resize(N) = Application.Transpose(D.Items)
End With
End Sub
'---------------------------------------------------------
"Thierry Schweitzer" a écrit dans le
message de groupe de
discussion :
Bonjour
j'ai besoins de pouvoir générer des clés uniques pour faire des coupons de
distribution (je travaille dans l'humanitaire)
je voudrais donc avec tout les lettres de l'alphabet et les 10 chiffres
mélangés au hasard et si possible que la chaine de charactere générée soit
unique
Si possible j'aimerais aussi avoir la possibilité de définir la longueur
de
la clé et quelles caractères je désire utiliser (par exemple 0 et O étant
similaire, pouvoir enlever l'un des deux. le resultat devrais etre sous
form
d'un tableaud'une colonne et d'un grand nombre de ligne (pour faire un
merge
avec word et produire les coupons en PDF pour l'imprimeur)
J'avais ca l'année dernière mais j'ai perdue la feuille Excel :(
Amitiés
Thierry
Bonjour Thierry,
Il ne te reste plus qu'à définir les variables selon tes besoins :
'---------------------------------------------------------
Sub Chaine_Caracteres_au_hasard()
Dim A As Long, B As Long, I As Long, X As Integer
Dim Arr(), N As Long, NbCar As Integer
Dim D As Object, Texte As String
Dim NomFeuille As String, Adr As String
'Liste des caractères possible :
Arr = Array("A", "B", "C", "D", "E", "F", "G", "H", _
"I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", _
"S", "T", "U", "V", "W", "X", "Y", "Z", 0, 1, 2, _
3, 4, 5, 6, 7, 8, 9)
'********* Variables à renseigner **************
NbCar = 10 'Nombre de caractères par chaîne
N = 1000 'Nombre de chaînes différentes
'que la procédure doit générer
NomFeuille = "Feuil1" ' nom de l'onglet de la feuille
'où la liste sera inscrite
Adr = "A1" ' Adresse de la première cellule
' où débutera la liste
'***************************************************
I = 0
Set D = CreateObject("Scripting.Dictionary")
Do Until I = N
For X = 1 To NbCar
Randomize
Texte = Texte & Arr(Int((UBound(Arr) - _
LBound(Arr) + 1) * Rnd + LBound(Arr)))
Next
If Not D.Exists(Texte) Then
D.Add Texte, Texte
I = I + 1
End If
Texte = ""
Loop
With Sheets(NomFeuille)
.Range(Adr).NumberFormat = "@"
.Range(Adr).Resize(N) = Application.Transpose(D.Items)
End With
End Sub
'---------------------------------------------------------
"Thierry Schweitzer" <thierry.schweitzer@gmail.com> a écrit dans le
message de groupe de
discussion : e5WjcpetJHA.4980@TK2MSFTNGP02.phx.gbl...
Bonjour
j'ai besoins de pouvoir générer des clés uniques pour faire des coupons de
distribution (je travaille dans l'humanitaire)
je voudrais donc avec tout les lettres de l'alphabet et les 10 chiffres
mélangés au hasard et si possible que la chaine de charactere générée soit
unique
Si possible j'aimerais aussi avoir la possibilité de définir la longueur
de
la clé et quelles caractères je désire utiliser (par exemple 0 et O étant
similaire, pouvoir enlever l'un des deux. le resultat devrais etre sous
form
d'un tableaud'une colonne et d'un grand nombre de ligne (pour faire un
merge
avec word et produire les coupons en PDF pour l'imprimeur)
J'avais ca l'année dernière mais j'ai perdue la feuille Excel :(
Amitiés
Thierry
Bonjour Thierry,
Il ne te reste plus qu'à définir les variables selon tes besoins :
'---------------------------------------------------------
Sub Chaine_Caracteres_au_hasard()
Dim A As Long, B As Long, I As Long, X As Integer
Dim Arr(), N As Long, NbCar As Integer
Dim D As Object, Texte As String
Dim NomFeuille As String, Adr As String
'Liste des caractères possible :
Arr = Array("A", "B", "C", "D", "E", "F", "G", "H", _
"I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", _
"S", "T", "U", "V", "W", "X", "Y", "Z", 0, 1, 2, _
3, 4, 5, 6, 7, 8, 9)
'********* Variables à renseigner **************
NbCar = 10 'Nombre de caractères par chaîne
N = 1000 'Nombre de chaînes différentes
'que la procédure doit générer
NomFeuille = "Feuil1" ' nom de l'onglet de la feuille
'où la liste sera inscrite
Adr = "A1" ' Adresse de la première cellule
' où débutera la liste
'***************************************************
I = 0
Set D = CreateObject("Scripting.Dictionary")
Do Until I = N
For X = 1 To NbCar
Randomize
Texte = Texte & Arr(Int((UBound(Arr) - _
LBound(Arr) + 1) * Rnd + LBound(Arr)))
Next
If Not D.Exists(Texte) Then
D.Add Texte, Texte
I = I + 1
End If
Texte = ""
Loop
With Sheets(NomFeuille)
.Range(Adr).NumberFormat = "@"
.Range(Adr).Resize(N) = Application.Transpose(D.Items)
End With
End Sub
'---------------------------------------------------------
"Thierry Schweitzer" a écrit dans le
message de groupe de
discussion :
Bonjour
j'ai besoins de pouvoir générer des clés uniques pour faire des coupons de
distribution (je travaille dans l'humanitaire)
je voudrais donc avec tout les lettres de l'alphabet et les 10 chiffres
mélangés au hasard et si possible que la chaine de charactere générée soit
unique
Si possible j'aimerais aussi avoir la possibilité de définir la longueur
de
la clé et quelles caractères je désire utiliser (par exemple 0 et O étant
similaire, pouvoir enlever l'un des deux. le resultat devrais etre sous
form
d'un tableaud'une colonne et d'un grand nombre de ligne (pour faire un
merge
avec word et produire les coupons en PDF pour l'imprimeur)
J'avais ca l'année dernière mais j'ai perdue la feuille Excel :(
Amitiés
Thierry
Bonjour Thierry,
Voilà la macro devrait s'exécuter normalement.
En lisant les commentaires, tu devrais trouver
comment renseigner les variables. Le nom
des feuilles, et chacune des adresses des cellules
relèvent de ton choix.
'---------------------------------------------------------
Sub Chaine_Caracteres_au_hasard()
Dim A As Long, B As Long, I As Long, X As Integer
Dim Arr(), N As Long, NbCar As Integer
Dim D As Object, Texte As String
Dim NomFeuille As String, Adr As String
Dim Sh As Worksheet, Rg As Range
'********* Variables à renseigner **************
'variables sont dans les cellules de la feuil1
With Worksheets("Feuil1")
'Nombre de caractères de chacune des chaînes
'Un petit test afin de t'assurer qu'elles ont
'au moins un caractère mais pas plus de 10
If .Range("B1") > 0 And .Range("B1") <= 10 Then
NbCar = .Range("B1")
Else
MsgBox "L'info en B1 est en dehors des " & _
"limites permises. Corriger."
Exit Sub
End If
'Nombre de chaînes désirées
If .Range("B1") > 0 And .Range("B1") <= 10000 Then
N = .Range("B2")
Else
MsgBox "Le nombre de chaîne se situe en " & _
"dehors de la limite 1- 10000."
Exit Sub
End If
'Nom onglet feuille où sera copié le résultat
NomFeuille = .Range("B3")
On Error Resume Next
Set Sh = Worksheets(NomFeuille)
If Err <> 0 Then
Err = 0
MsgBox "le nom de la feuille de destination " & _
"n'existe pas. opération annulée."
Exit Sub
End If
'Adresse de la première cellule
'où le résultat sera copié.
Adr = .Range("B4")
Set Rg = Worksheets(NomFeuille).Range(Adr)
If Err <> 0 Then
Err = 0
MsgBox "L'adresse de la cellule de destination " & _
"est incorrecte. opération annulée."
Exit Sub
End If
'Plage de cellules listant séparément (1 par cellule)
'la liste des caractères faisant parti du tirage.
'Il ne doit pas y avoir de cellules vides car tu auras
'des "vides" dans les chaînes créées.
With .Range("A1:A" & .Range("A65536").End(xlUp).Row)
If .Rows.Count = 1 Or _
.Count <> Application.CountA(.Value) Then
MsgBox "Irrégularités dans la liste des " & _
"symboles disponibles pour la création des chaînes."
Exit Sub
End If
End With
End With
'***************************************************
I = 0
Set D = CreateObject("Scripting.Dictionary")
Do Until I = N
For X = 1 To NbCar
Randomize
Texte = Texte & Arr(Int((UBound(Arr, 1) - _
LBound(Arr, 1) + 1) * Rnd + LBound(Arr, 1)), 1)
Next
If Not D.Exists(Texte) Then
D.Add Texte, Texte
I = I + 1
End If
Texte = ""
Loop
With Sheets(NomFeuille)
.Range(Adr).NumberFormat = "@"
.Range(Adr).Resize(N) = Application.Transpose(D.Items)
End With
End Sub
'---------------------------------------------------------
"Thierry Schweitzer" a écrit dans le
message de groupe de
discussion : #
Superbe
elle marche super bien la macro
par contre serais t'il possible d'appeler les variables de la fille elle
meme, ou d'une autre feuille.
ciomme je desire faire remonter cette feuille au siege de mon organisation
pour etre utiliser ailleurs, renter dans un page de code visual basic,
n'est
pas à la porté de tout le monde !!
donc par example dans une page utilitée "variable"
avoir les cellule B2, B3 etc...
donc en faite pour que je fasse quant meme quelque chose
'********* Variables à renseigner **************
NbCar = 10 'Nombre de caractères par chaîne
N = 1000 'Nombre de chaînes différentes
'que la procédure doit générer
NomFeuille = "Feuil1" ' nom de l'onglet de la feuille
'où la liste sera inscrite
Adr = "A1" ' Adresse de la première cellule
' où débutera la liste
'***************************************************
Comment appeler la cellule B2 de la page "Variable" pour informer la
valeur
NbCar, et ainsi de suite ?? Si c'est possible
merci encore
Thierry
"MichDenis" a écrit dans le message de news:Bonjour Thierry,
Il ne te reste plus qu'à définir les variables selon tes besoins :
'---------------------------------------------------------
Sub Chaine_Caracteres_au_hasard()
Dim A As Long, B As Long, I As Long, X As Integer
Dim Arr(), N As Long, NbCar As Integer
Dim D As Object, Texte As String
Dim NomFeuille As String, Adr As String
'Liste des caractères possible :
Arr = Array("A", "B", "C", "D", "E", "F", "G", "H", _
"I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", _
"S", "T", "U", "V", "W", "X", "Y", "Z", 0, 1, 2, _
3, 4, 5, 6, 7, 8, 9)
'********* Variables à renseigner **************
NbCar = 10 'Nombre de caractères par chaîne
N = 1000 'Nombre de chaînes différentes
'que la procédure doit générer
NomFeuille = "Feuil1" ' nom de l'onglet de la feuille
'où la liste sera inscrite
Adr = "A1" ' Adresse de la première cellule
' où débutera la liste
'***************************************************
I = 0
Set D = CreateObject("Scripting.Dictionary")
Do Until I = N
For X = 1 To NbCar
Randomize
Texte = Texte & Arr(Int((UBound(Arr) - _
LBound(Arr) + 1) * Rnd + LBound(Arr)))
Next
If Not D.Exists(Texte) Then
D.Add Texte, Texte
I = I + 1
End If
Texte = ""
Loop
With Sheets(NomFeuille)
.Range(Adr).NumberFormat = "@"
.Range(Adr).Resize(N) = Application.Transpose(D.Items)
End With
End Sub
'---------------------------------------------------------
"Thierry Schweitzer" a écrit dans le
message de groupe de
discussion :
Bonjour
j'ai besoins de pouvoir générer des clés uniques pour faire des coupons
de
distribution (je travaille dans l'humanitaire)
je voudrais donc avec tout les lettres de l'alphabet et les 10 chiffres
mélangés au hasard et si possible que la chaine de charactere générée
soit
unique
Si possible j'aimerais aussi avoir la possibilité de définir la longueur
de
la clé et quelles caractères je désire utiliser (par exemple 0 et O étant
similaire, pouvoir enlever l'un des deux. le resultat devrais etre sous
form
d'un tableaud'une colonne et d'un grand nombre de ligne (pour faire un
merge
avec word et produire les coupons en PDF pour l'imprimeur)
J'avais ca l'année dernière mais j'ai perdue la feuille Excel :(
Amitiés
Thierry
Bonjour Thierry,
Voilà la macro devrait s'exécuter normalement.
En lisant les commentaires, tu devrais trouver
comment renseigner les variables. Le nom
des feuilles, et chacune des adresses des cellules
relèvent de ton choix.
'---------------------------------------------------------
Sub Chaine_Caracteres_au_hasard()
Dim A As Long, B As Long, I As Long, X As Integer
Dim Arr(), N As Long, NbCar As Integer
Dim D As Object, Texte As String
Dim NomFeuille As String, Adr As String
Dim Sh As Worksheet, Rg As Range
'********* Variables à renseigner **************
'variables sont dans les cellules de la feuil1
With Worksheets("Feuil1")
'Nombre de caractères de chacune des chaînes
'Un petit test afin de t'assurer qu'elles ont
'au moins un caractère mais pas plus de 10
If .Range("B1") > 0 And .Range("B1") <= 10 Then
NbCar = .Range("B1")
Else
MsgBox "L'info en B1 est en dehors des " & _
"limites permises. Corriger."
Exit Sub
End If
'Nombre de chaînes désirées
If .Range("B1") > 0 And .Range("B1") <= 10000 Then
N = .Range("B2")
Else
MsgBox "Le nombre de chaîne se situe en " & _
"dehors de la limite 1- 10000."
Exit Sub
End If
'Nom onglet feuille où sera copié le résultat
NomFeuille = .Range("B3")
On Error Resume Next
Set Sh = Worksheets(NomFeuille)
If Err <> 0 Then
Err = 0
MsgBox "le nom de la feuille de destination " & _
"n'existe pas. opération annulée."
Exit Sub
End If
'Adresse de la première cellule
'où le résultat sera copié.
Adr = .Range("B4")
Set Rg = Worksheets(NomFeuille).Range(Adr)
If Err <> 0 Then
Err = 0
MsgBox "L'adresse de la cellule de destination " & _
"est incorrecte. opération annulée."
Exit Sub
End If
'Plage de cellules listant séparément (1 par cellule)
'la liste des caractères faisant parti du tirage.
'Il ne doit pas y avoir de cellules vides car tu auras
'des "vides" dans les chaînes créées.
With .Range("A1:A" & .Range("A65536").End(xlUp).Row)
If .Rows.Count = 1 Or _
.Count <> Application.CountA(.Value) Then
MsgBox "Irrégularités dans la liste des " & _
"symboles disponibles pour la création des chaînes."
Exit Sub
End If
End With
End With
'***************************************************
I = 0
Set D = CreateObject("Scripting.Dictionary")
Do Until I = N
For X = 1 To NbCar
Randomize
Texte = Texte & Arr(Int((UBound(Arr, 1) - _
LBound(Arr, 1) + 1) * Rnd + LBound(Arr, 1)), 1)
Next
If Not D.Exists(Texte) Then
D.Add Texte, Texte
I = I + 1
End If
Texte = ""
Loop
With Sheets(NomFeuille)
.Range(Adr).NumberFormat = "@"
.Range(Adr).Resize(N) = Application.Transpose(D.Items)
End With
End Sub
'---------------------------------------------------------
"Thierry Schweitzer" <thierry.schweitzer@gmail.com> a écrit dans le
message de groupe de
discussion : #GzrQ8DuJHA.2596@TK2MSFTNGP02.phx.gbl...
Superbe
elle marche super bien la macro
par contre serais t'il possible d'appeler les variables de la fille elle
meme, ou d'une autre feuille.
ciomme je desire faire remonter cette feuille au siege de mon organisation
pour etre utiliser ailleurs, renter dans un page de code visual basic,
n'est
pas à la porté de tout le monde !!
donc par example dans une page utilitée "variable"
avoir les cellule B2, B3 etc...
donc en faite pour que je fasse quant meme quelque chose
'********* Variables à renseigner **************
NbCar = 10 'Nombre de caractères par chaîne
N = 1000 'Nombre de chaînes différentes
'que la procédure doit générer
NomFeuille = "Feuil1" ' nom de l'onglet de la feuille
'où la liste sera inscrite
Adr = "A1" ' Adresse de la première cellule
' où débutera la liste
'***************************************************
Comment appeler la cellule B2 de la page "Variable" pour informer la
valeur
NbCar, et ainsi de suite ?? Si c'est possible
merci encore
Thierry
"MichDenis" <michdenis@hotmail.com> a écrit dans le message de news:
EBD2036D-C6E1-477D-BE3E-AD2853D8DC83@microsoft.com...
Bonjour Thierry,
Il ne te reste plus qu'à définir les variables selon tes besoins :
'---------------------------------------------------------
Sub Chaine_Caracteres_au_hasard()
Dim A As Long, B As Long, I As Long, X As Integer
Dim Arr(), N As Long, NbCar As Integer
Dim D As Object, Texte As String
Dim NomFeuille As String, Adr As String
'Liste des caractères possible :
Arr = Array("A", "B", "C", "D", "E", "F", "G", "H", _
"I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", _
"S", "T", "U", "V", "W", "X", "Y", "Z", 0, 1, 2, _
3, 4, 5, 6, 7, 8, 9)
'********* Variables à renseigner **************
NbCar = 10 'Nombre de caractères par chaîne
N = 1000 'Nombre de chaînes différentes
'que la procédure doit générer
NomFeuille = "Feuil1" ' nom de l'onglet de la feuille
'où la liste sera inscrite
Adr = "A1" ' Adresse de la première cellule
' où débutera la liste
'***************************************************
I = 0
Set D = CreateObject("Scripting.Dictionary")
Do Until I = N
For X = 1 To NbCar
Randomize
Texte = Texte & Arr(Int((UBound(Arr) - _
LBound(Arr) + 1) * Rnd + LBound(Arr)))
Next
If Not D.Exists(Texte) Then
D.Add Texte, Texte
I = I + 1
End If
Texte = ""
Loop
With Sheets(NomFeuille)
.Range(Adr).NumberFormat = "@"
.Range(Adr).Resize(N) = Application.Transpose(D.Items)
End With
End Sub
'---------------------------------------------------------
"Thierry Schweitzer" <thierry.schweitzer@gmail.com> a écrit dans le
message de groupe de
discussion : e5WjcpetJHA.4980@TK2MSFTNGP02.phx.gbl...
Bonjour
j'ai besoins de pouvoir générer des clés uniques pour faire des coupons
de
distribution (je travaille dans l'humanitaire)
je voudrais donc avec tout les lettres de l'alphabet et les 10 chiffres
mélangés au hasard et si possible que la chaine de charactere générée
soit
unique
Si possible j'aimerais aussi avoir la possibilité de définir la longueur
de
la clé et quelles caractères je désire utiliser (par exemple 0 et O étant
similaire, pouvoir enlever l'un des deux. le resultat devrais etre sous
form
d'un tableaud'une colonne et d'un grand nombre de ligne (pour faire un
merge
avec word et produire les coupons en PDF pour l'imprimeur)
J'avais ca l'année dernière mais j'ai perdue la feuille Excel :(
Amitiés
Thierry
Bonjour Thierry,
Voilà la macro devrait s'exécuter normalement.
En lisant les commentaires, tu devrais trouver
comment renseigner les variables. Le nom
des feuilles, et chacune des adresses des cellules
relèvent de ton choix.
'---------------------------------------------------------
Sub Chaine_Caracteres_au_hasard()
Dim A As Long, B As Long, I As Long, X As Integer
Dim Arr(), N As Long, NbCar As Integer
Dim D As Object, Texte As String
Dim NomFeuille As String, Adr As String
Dim Sh As Worksheet, Rg As Range
'********* Variables à renseigner **************
'variables sont dans les cellules de la feuil1
With Worksheets("Feuil1")
'Nombre de caractères de chacune des chaînes
'Un petit test afin de t'assurer qu'elles ont
'au moins un caractère mais pas plus de 10
If .Range("B1") > 0 And .Range("B1") <= 10 Then
NbCar = .Range("B1")
Else
MsgBox "L'info en B1 est en dehors des " & _
"limites permises. Corriger."
Exit Sub
End If
'Nombre de chaînes désirées
If .Range("B1") > 0 And .Range("B1") <= 10000 Then
N = .Range("B2")
Else
MsgBox "Le nombre de chaîne se situe en " & _
"dehors de la limite 1- 10000."
Exit Sub
End If
'Nom onglet feuille où sera copié le résultat
NomFeuille = .Range("B3")
On Error Resume Next
Set Sh = Worksheets(NomFeuille)
If Err <> 0 Then
Err = 0
MsgBox "le nom de la feuille de destination " & _
"n'existe pas. opération annulée."
Exit Sub
End If
'Adresse de la première cellule
'où le résultat sera copié.
Adr = .Range("B4")
Set Rg = Worksheets(NomFeuille).Range(Adr)
If Err <> 0 Then
Err = 0
MsgBox "L'adresse de la cellule de destination " & _
"est incorrecte. opération annulée."
Exit Sub
End If
'Plage de cellules listant séparément (1 par cellule)
'la liste des caractères faisant parti du tirage.
'Il ne doit pas y avoir de cellules vides car tu auras
'des "vides" dans les chaînes créées.
With .Range("A1:A" & .Range("A65536").End(xlUp).Row)
If .Rows.Count = 1 Or _
.Count <> Application.CountA(.Value) Then
MsgBox "Irrégularités dans la liste des " & _
"symboles disponibles pour la création des chaînes."
Exit Sub
End If
End With
End With
'***************************************************
I = 0
Set D = CreateObject("Scripting.Dictionary")
Do Until I = N
For X = 1 To NbCar
Randomize
Texte = Texte & Arr(Int((UBound(Arr, 1) - _
LBound(Arr, 1) + 1) * Rnd + LBound(Arr, 1)), 1)
Next
If Not D.Exists(Texte) Then
D.Add Texte, Texte
I = I + 1
End If
Texte = ""
Loop
With Sheets(NomFeuille)
.Range(Adr).NumberFormat = "@"
.Range(Adr).Resize(N) = Application.Transpose(D.Items)
End With
End Sub
'---------------------------------------------------------
"Thierry Schweitzer" a écrit dans le
message de groupe de
discussion : #
Superbe
elle marche super bien la macro
par contre serais t'il possible d'appeler les variables de la fille elle
meme, ou d'une autre feuille.
ciomme je desire faire remonter cette feuille au siege de mon organisation
pour etre utiliser ailleurs, renter dans un page de code visual basic,
n'est
pas à la porté de tout le monde !!
donc par example dans une page utilitée "variable"
avoir les cellule B2, B3 etc...
donc en faite pour que je fasse quant meme quelque chose
'********* Variables à renseigner **************
NbCar = 10 'Nombre de caractères par chaîne
N = 1000 'Nombre de chaînes différentes
'que la procédure doit générer
NomFeuille = "Feuil1" ' nom de l'onglet de la feuille
'où la liste sera inscrite
Adr = "A1" ' Adresse de la première cellule
' où débutera la liste
'***************************************************
Comment appeler la cellule B2 de la page "Variable" pour informer la
valeur
NbCar, et ainsi de suite ?? Si c'est possible
merci encore
Thierry
"MichDenis" a écrit dans le message de news:Bonjour Thierry,
Il ne te reste plus qu'à définir les variables selon tes besoins :
'---------------------------------------------------------
Sub Chaine_Caracteres_au_hasard()
Dim A As Long, B As Long, I As Long, X As Integer
Dim Arr(), N As Long, NbCar As Integer
Dim D As Object, Texte As String
Dim NomFeuille As String, Adr As String
'Liste des caractères possible :
Arr = Array("A", "B", "C", "D", "E", "F", "G", "H", _
"I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", _
"S", "T", "U", "V", "W", "X", "Y", "Z", 0, 1, 2, _
3, 4, 5, 6, 7, 8, 9)
'********* Variables à renseigner **************
NbCar = 10 'Nombre de caractères par chaîne
N = 1000 'Nombre de chaînes différentes
'que la procédure doit générer
NomFeuille = "Feuil1" ' nom de l'onglet de la feuille
'où la liste sera inscrite
Adr = "A1" ' Adresse de la première cellule
' où débutera la liste
'***************************************************
I = 0
Set D = CreateObject("Scripting.Dictionary")
Do Until I = N
For X = 1 To NbCar
Randomize
Texte = Texte & Arr(Int((UBound(Arr) - _
LBound(Arr) + 1) * Rnd + LBound(Arr)))
Next
If Not D.Exists(Texte) Then
D.Add Texte, Texte
I = I + 1
End If
Texte = ""
Loop
With Sheets(NomFeuille)
.Range(Adr).NumberFormat = "@"
.Range(Adr).Resize(N) = Application.Transpose(D.Items)
End With
End Sub
'---------------------------------------------------------
"Thierry Schweitzer" a écrit dans le
message de groupe de
discussion :
Bonjour
j'ai besoins de pouvoir générer des clés uniques pour faire des coupons
de
distribution (je travaille dans l'humanitaire)
je voudrais donc avec tout les lettres de l'alphabet et les 10 chiffres
mélangés au hasard et si possible que la chaine de charactere générée
soit
unique
Si possible j'aimerais aussi avoir la possibilité de définir la longueur
de
la clé et quelles caractères je désire utiliser (par exemple 0 et O étant
similaire, pouvoir enlever l'un des deux. le resultat devrais etre sous
form
d'un tableaud'une colonne et d'un grand nombre de ligne (pour faire un
merge
avec word et produire les coupons en PDF pour l'imprimeur)
J'avais ca l'année dernière mais j'ai perdue la feuille Excel :(
Amitiés
Thierry
Bonjour Thierry,
Voilà la macro devrait s'exécuter normalement.
En lisant les commentaires, tu devrais trouver
comment renseigner les variables. Le nom
des feuilles, et chacune des adresses des cellules
relèvent de ton choix.
'---------------------------------------------------------
Sub Chaine_Caracteres_au_hasard()
Dim A As Long, B As Long, I As Long, X As Integer
Dim Arr(), N As Long, NbCar As Integer
Dim D As Object, Texte As String
Dim NomFeuille As String, Adr As String
Dim Sh As Worksheet, Rg As Range
'********* Variables à renseigner **************
'variables sont dans les cellules de la feuil1
With Worksheets("Feuil1")
'Nombre de caractères de chacune des chaînes
'Un petit test afin de t'assurer qu'elles ont
'au moins un caractère mais pas plus de 10
If .Range("B1") > 0 And .Range("B1") <= 10 Then
NbCar = .Range("B1")
Else
MsgBox "L'info en B1 est en dehors des " & _
"limites permises. Corriger."
Exit Sub
End If
'Nombre de chaînes désirées
If .Range("B1") > 0 And .Range("B1") <= 10000 Then
N = .Range("B2")
Else
MsgBox "Le nombre de chaîne se situe en " & _
"dehors de la limite 1- 10000."
Exit Sub
End If
'Nom onglet feuille où sera copié le résultat
NomFeuille = .Range("B3")
On Error Resume Next
Set Sh = Worksheets(NomFeuille)
If Err <> 0 Then
Err = 0
MsgBox "le nom de la feuille de destination " & _
"n'existe pas. opération annulée."
Exit Sub
End If
'Adresse de la première cellule
'où le résultat sera copié.
Adr = .Range("B4")
Set Rg = Worksheets(NomFeuille).Range(Adr)
If Err <> 0 Then
Err = 0
MsgBox "L'adresse de la cellule de destination " & _
"est incorrecte. opération annulée."
Exit Sub
End If
'Plage de cellules listant séparément (1 par cellule)
'la liste des caractères faisant parti du tirage.
'Il ne doit pas y avoir de cellules vides car tu auras
'des "vides" dans les chaînes créées.
With .Range("A1:A" & .Range("A65536").End(xlUp).Row)
If .Rows.Count = 1 Or _
.Count <> Application.CountA(.Value) Then
MsgBox "Irrégularités dans la liste des " & _
"symboles disponibles pour la création des chaînes."
Exit Sub
End If
End With
End With
'***************************************************
I = 0
Set D = CreateObject("Scripting.Dictionary")
Do Until I = N
For X = 1 To NbCar
Randomize
Texte = Texte & Arr(Int((UBound(Arr, 1) - _
LBound(Arr, 1) + 1) * Rnd + LBound(Arr, 1)), 1)
Next
If Not D.Exists(Texte) Then
D.Add Texte, Texte
I = I + 1
End If
Texte = ""
Loop
With Sheets(NomFeuille)
.Range(Adr).NumberFormat = "@"
.Range(Adr).Resize(N) = Application.Transpose(D.Items)
End With
End Sub
'---------------------------------------------------------
"Thierry Schweitzer" a écrit dans le
message de groupe de
discussion : #
Superbe
elle marche super bien la macro
par contre serais t'il possible d'appeler les variables de la fille elle
meme, ou d'une autre feuille.
ciomme je desire faire remonter cette feuille au siege de mon organisation
pour etre utiliser ailleurs, renter dans un page de code visual basic,
n'est
pas à la porté de tout le monde !!
donc par example dans une page utilitée "variable"
avoir les cellule B2, B3 etc...
donc en faite pour que je fasse quant meme quelque chose
'********* Variables à renseigner **************
NbCar = 10 'Nombre de caractères par chaîne
N = 1000 'Nombre de chaînes différentes
'que la procédure doit générer
NomFeuille = "Feuil1" ' nom de l'onglet de la feuille
'où la liste sera inscrite
Adr = "A1" ' Adresse de la première cellule
' où débutera la liste
'***************************************************
Comment appeler la cellule B2 de la page "Variable" pour informer la
valeur
NbCar, et ainsi de suite ?? Si c'est possible
merci encore
Thierry
"MichDenis" a écrit dans le message de news:Bonjour Thierry,
Il ne te reste plus qu'à définir les variables selon tes besoins :
'---------------------------------------------------------
Sub Chaine_Caracteres_au_hasard()
Dim A As Long, B As Long, I As Long, X As Integer
Dim Arr(), N As Long, NbCar As Integer
Dim D As Object, Texte As String
Dim NomFeuille As String, Adr As String
'Liste des caractères possible :
Arr = Array("A", "B", "C", "D", "E", "F", "G", "H", _
"I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", _
"S", "T", "U", "V", "W", "X", "Y", "Z", 0, 1, 2, _
3, 4, 5, 6, 7, 8, 9)
'********* Variables à renseigner **************
NbCar = 10 'Nombre de caractères par chaîne
N = 1000 'Nombre de chaînes différentes
'que la procédure doit générer
NomFeuille = "Feuil1" ' nom de l'onglet de la feuille
'où la liste sera inscrite
Adr = "A1" ' Adresse de la première cellule
' où débutera la liste
'***************************************************
I = 0
Set D = CreateObject("Scripting.Dictionary")
Do Until I = N
For X = 1 To NbCar
Randomize
Texte = Texte & Arr(Int((UBound(Arr) - _
LBound(Arr) + 1) * Rnd + LBound(Arr)))
Next
If Not D.Exists(Texte) Then
D.Add Texte, Texte
I = I + 1
End If
Texte = ""
Loop
With Sheets(NomFeuille)
.Range(Adr).NumberFormat = "@"
.Range(Adr).Resize(N) = Application.Transpose(D.Items)
End With
End Sub
'---------------------------------------------------------
"Thierry Schweitzer" a écrit dans le
message de groupe de
discussion :
Bonjour
j'ai besoins de pouvoir générer des clés uniques pour faire des coupons
de
distribution (je travaille dans l'humanitaire)
je voudrais donc avec tout les lettres de l'alphabet et les 10 chiffres
mélangés au hasard et si possible que la chaine de charactere générée
soit
unique
Si possible j'aimerais aussi avoir la possibilité de définir la longueur
de
la clé et quelles caractères je désire utiliser (par exemple 0 et O étant
similaire, pouvoir enlever l'un des deux. le resultat devrais etre sous
form
d'un tableaud'une colonne et d'un grand nombre de ligne (pour faire un
merge
avec word et produire les coupons en PDF pour l'imprimeur)
J'avais ca l'année dernière mais j'ai perdue la feuille Excel :(
Amitiés
Thierry
Bonjour Thierry,
Voilà la macro devrait s'exécuter normalement.
En lisant les commentaires, tu devrais trouver
comment renseigner les variables. Le nom
des feuilles, et chacune des adresses des cellules
relèvent de ton choix.
'---------------------------------------------------------
Sub Chaine_Caracteres_au_hasard()
Dim A As Long, B As Long, I As Long, X As Integer
Dim Arr(), N As Long, NbCar As Integer
Dim D As Object, Texte As String
Dim NomFeuille As String, Adr As String
Dim Sh As Worksheet, Rg As Range
'********* Variables à renseigner **************
'variables sont dans les cellules de la feuil1
With Worksheets("Feuil1")
'Nombre de caractères de chacune des chaînes
'Un petit test afin de t'assurer qu'elles ont
'au moins un caractère mais pas plus de 10
If .Range("B1") > 0 And .Range("B1") <= 10 Then
NbCar = .Range("B1")
Else
MsgBox "L'info en B1 est en dehors des " & _
"limites permises. Corriger."
Exit Sub
End If
'Nombre de chaînes désirées
If .Range("B1") > 0 And .Range("B1") <= 10000 Then
N = .Range("B2")
Else
MsgBox "Le nombre de chaîne se situe en " & _
"dehors de la limite 1- 10000."
Exit Sub
End If
'Nom onglet feuille où sera copié le résultat
NomFeuille = .Range("B3")
On Error Resume Next
Set Sh = Worksheets(NomFeuille)
If Err <> 0 Then
Err = 0
MsgBox "le nom de la feuille de destination " & _
"n'existe pas. opération annulée."
Exit Sub
End If
'Adresse de la première cellule
'où le résultat sera copié.
Adr = .Range("B4")
Set Rg = Worksheets(NomFeuille).Range(Adr)
If Err <> 0 Then
Err = 0
MsgBox "L'adresse de la cellule de destination " & _
"est incorrecte. opération annulée."
Exit Sub
End If
'Plage de cellules listant séparément (1 par cellule)
'la liste des caractères faisant parti du tirage.
'Il ne doit pas y avoir de cellules vides car tu auras
'des "vides" dans les chaînes créées.
With .Range("A1:A" & .Range("A65536").End(xlUp).Row)
If .Rows.Count = 1 Or _
.Count <> Application.CountA(.Value) Then
MsgBox "Irrégularités dans la liste des " & _
"symboles disponibles pour la création des chaînes."
Exit Sub
End If
End With
End With
'***************************************************
I = 0
Set D = CreateObject("Scripting.Dictionary")
Do Until I = N
For X = 1 To NbCar
Randomize
Texte = Texte & Arr(Int((UBound(Arr, 1) - _
LBound(Arr, 1) + 1) * Rnd + LBound(Arr, 1)), 1)
Next
If Not D.Exists(Texte) Then
D.Add Texte, Texte
I = I + 1
End If
Texte = ""
Loop
With Sheets(NomFeuille)
.Range(Adr).NumberFormat = "@"
.Range(Adr).Resize(N) = Application.Transpose(D.Items)
End With
End Sub
'---------------------------------------------------------
"Thierry Schweitzer" <thierry.schweitzer@gmail.com> a écrit dans le
message de groupe de
discussion : #GzrQ8DuJHA.2596@TK2MSFTNGP02.phx.gbl...
Superbe
elle marche super bien la macro
par contre serais t'il possible d'appeler les variables de la fille elle
meme, ou d'une autre feuille.
ciomme je desire faire remonter cette feuille au siege de mon organisation
pour etre utiliser ailleurs, renter dans un page de code visual basic,
n'est
pas à la porté de tout le monde !!
donc par example dans une page utilitée "variable"
avoir les cellule B2, B3 etc...
donc en faite pour que je fasse quant meme quelque chose
'********* Variables à renseigner **************
NbCar = 10 'Nombre de caractères par chaîne
N = 1000 'Nombre de chaînes différentes
'que la procédure doit générer
NomFeuille = "Feuil1" ' nom de l'onglet de la feuille
'où la liste sera inscrite
Adr = "A1" ' Adresse de la première cellule
' où débutera la liste
'***************************************************
Comment appeler la cellule B2 de la page "Variable" pour informer la
valeur
NbCar, et ainsi de suite ?? Si c'est possible
merci encore
Thierry
"MichDenis" <michdenis@hotmail.com> a écrit dans le message de news:
EBD2036D-C6E1-477D-BE3E-AD2853D8DC83@microsoft.com...
Bonjour Thierry,
Il ne te reste plus qu'à définir les variables selon tes besoins :
'---------------------------------------------------------
Sub Chaine_Caracteres_au_hasard()
Dim A As Long, B As Long, I As Long, X As Integer
Dim Arr(), N As Long, NbCar As Integer
Dim D As Object, Texte As String
Dim NomFeuille As String, Adr As String
'Liste des caractères possible :
Arr = Array("A", "B", "C", "D", "E", "F", "G", "H", _
"I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", _
"S", "T", "U", "V", "W", "X", "Y", "Z", 0, 1, 2, _
3, 4, 5, 6, 7, 8, 9)
'********* Variables à renseigner **************
NbCar = 10 'Nombre de caractères par chaîne
N = 1000 'Nombre de chaînes différentes
'que la procédure doit générer
NomFeuille = "Feuil1" ' nom de l'onglet de la feuille
'où la liste sera inscrite
Adr = "A1" ' Adresse de la première cellule
' où débutera la liste
'***************************************************
I = 0
Set D = CreateObject("Scripting.Dictionary")
Do Until I = N
For X = 1 To NbCar
Randomize
Texte = Texte & Arr(Int((UBound(Arr) - _
LBound(Arr) + 1) * Rnd + LBound(Arr)))
Next
If Not D.Exists(Texte) Then
D.Add Texte, Texte
I = I + 1
End If
Texte = ""
Loop
With Sheets(NomFeuille)
.Range(Adr).NumberFormat = "@"
.Range(Adr).Resize(N) = Application.Transpose(D.Items)
End With
End Sub
'---------------------------------------------------------
"Thierry Schweitzer" <thierry.schweitzer@gmail.com> a écrit dans le
message de groupe de
discussion : e5WjcpetJHA.4980@TK2MSFTNGP02.phx.gbl...
Bonjour
j'ai besoins de pouvoir générer des clés uniques pour faire des coupons
de
distribution (je travaille dans l'humanitaire)
je voudrais donc avec tout les lettres de l'alphabet et les 10 chiffres
mélangés au hasard et si possible que la chaine de charactere générée
soit
unique
Si possible j'aimerais aussi avoir la possibilité de définir la longueur
de
la clé et quelles caractères je désire utiliser (par exemple 0 et O étant
similaire, pouvoir enlever l'un des deux. le resultat devrais etre sous
form
d'un tableaud'une colonne et d'un grand nombre de ligne (pour faire un
merge
avec word et produire les coupons en PDF pour l'imprimeur)
J'avais ca l'année dernière mais j'ai perdue la feuille Excel :(
Amitiés
Thierry
Bonjour Thierry,
Voilà la macro devrait s'exécuter normalement.
En lisant les commentaires, tu devrais trouver
comment renseigner les variables. Le nom
des feuilles, et chacune des adresses des cellules
relèvent de ton choix.
'---------------------------------------------------------
Sub Chaine_Caracteres_au_hasard()
Dim A As Long, B As Long, I As Long, X As Integer
Dim Arr(), N As Long, NbCar As Integer
Dim D As Object, Texte As String
Dim NomFeuille As String, Adr As String
Dim Sh As Worksheet, Rg As Range
'********* Variables à renseigner **************
'variables sont dans les cellules de la feuil1
With Worksheets("Feuil1")
'Nombre de caractères de chacune des chaînes
'Un petit test afin de t'assurer qu'elles ont
'au moins un caractère mais pas plus de 10
If .Range("B1") > 0 And .Range("B1") <= 10 Then
NbCar = .Range("B1")
Else
MsgBox "L'info en B1 est en dehors des " & _
"limites permises. Corriger."
Exit Sub
End If
'Nombre de chaînes désirées
If .Range("B1") > 0 And .Range("B1") <= 10000 Then
N = .Range("B2")
Else
MsgBox "Le nombre de chaîne se situe en " & _
"dehors de la limite 1- 10000."
Exit Sub
End If
'Nom onglet feuille où sera copié le résultat
NomFeuille = .Range("B3")
On Error Resume Next
Set Sh = Worksheets(NomFeuille)
If Err <> 0 Then
Err = 0
MsgBox "le nom de la feuille de destination " & _
"n'existe pas. opération annulée."
Exit Sub
End If
'Adresse de la première cellule
'où le résultat sera copié.
Adr = .Range("B4")
Set Rg = Worksheets(NomFeuille).Range(Adr)
If Err <> 0 Then
Err = 0
MsgBox "L'adresse de la cellule de destination " & _
"est incorrecte. opération annulée."
Exit Sub
End If
'Plage de cellules listant séparément (1 par cellule)
'la liste des caractères faisant parti du tirage.
'Il ne doit pas y avoir de cellules vides car tu auras
'des "vides" dans les chaînes créées.
With .Range("A1:A" & .Range("A65536").End(xlUp).Row)
If .Rows.Count = 1 Or _
.Count <> Application.CountA(.Value) Then
MsgBox "Irrégularités dans la liste des " & _
"symboles disponibles pour la création des chaînes."
Exit Sub
End If
End With
End With
'***************************************************
I = 0
Set D = CreateObject("Scripting.Dictionary")
Do Until I = N
For X = 1 To NbCar
Randomize
Texte = Texte & Arr(Int((UBound(Arr, 1) - _
LBound(Arr, 1) + 1) * Rnd + LBound(Arr, 1)), 1)
Next
If Not D.Exists(Texte) Then
D.Add Texte, Texte
I = I + 1
End If
Texte = ""
Loop
With Sheets(NomFeuille)
.Range(Adr).NumberFormat = "@"
.Range(Adr).Resize(N) = Application.Transpose(D.Items)
End With
End Sub
'---------------------------------------------------------
"Thierry Schweitzer" a écrit dans le
message de groupe de
discussion : #
Superbe
elle marche super bien la macro
par contre serais t'il possible d'appeler les variables de la fille elle
meme, ou d'une autre feuille.
ciomme je desire faire remonter cette feuille au siege de mon organisation
pour etre utiliser ailleurs, renter dans un page de code visual basic,
n'est
pas à la porté de tout le monde !!
donc par example dans une page utilitée "variable"
avoir les cellule B2, B3 etc...
donc en faite pour que je fasse quant meme quelque chose
'********* Variables à renseigner **************
NbCar = 10 'Nombre de caractères par chaîne
N = 1000 'Nombre de chaînes différentes
'que la procédure doit générer
NomFeuille = "Feuil1" ' nom de l'onglet de la feuille
'où la liste sera inscrite
Adr = "A1" ' Adresse de la première cellule
' où débutera la liste
'***************************************************
Comment appeler la cellule B2 de la page "Variable" pour informer la
valeur
NbCar, et ainsi de suite ?? Si c'est possible
merci encore
Thierry
"MichDenis" a écrit dans le message de news:Bonjour Thierry,
Il ne te reste plus qu'à définir les variables selon tes besoins :
'---------------------------------------------------------
Sub Chaine_Caracteres_au_hasard()
Dim A As Long, B As Long, I As Long, X As Integer
Dim Arr(), N As Long, NbCar As Integer
Dim D As Object, Texte As String
Dim NomFeuille As String, Adr As String
'Liste des caractères possible :
Arr = Array("A", "B", "C", "D", "E", "F", "G", "H", _
"I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", _
"S", "T", "U", "V", "W", "X", "Y", "Z", 0, 1, 2, _
3, 4, 5, 6, 7, 8, 9)
'********* Variables à renseigner **************
NbCar = 10 'Nombre de caractères par chaîne
N = 1000 'Nombre de chaînes différentes
'que la procédure doit générer
NomFeuille = "Feuil1" ' nom de l'onglet de la feuille
'où la liste sera inscrite
Adr = "A1" ' Adresse de la première cellule
' où débutera la liste
'***************************************************
I = 0
Set D = CreateObject("Scripting.Dictionary")
Do Until I = N
For X = 1 To NbCar
Randomize
Texte = Texte & Arr(Int((UBound(Arr) - _
LBound(Arr) + 1) * Rnd + LBound(Arr)))
Next
If Not D.Exists(Texte) Then
D.Add Texte, Texte
I = I + 1
End If
Texte = ""
Loop
With Sheets(NomFeuille)
.Range(Adr).NumberFormat = "@"
.Range(Adr).Resize(N) = Application.Transpose(D.Items)
End With
End Sub
'---------------------------------------------------------
"Thierry Schweitzer" a écrit dans le
message de groupe de
discussion :
Bonjour
j'ai besoins de pouvoir générer des clés uniques pour faire des coupons
de
distribution (je travaille dans l'humanitaire)
je voudrais donc avec tout les lettres de l'alphabet et les 10 chiffres
mélangés au hasard et si possible que la chaine de charactere générée
soit
unique
Si possible j'aimerais aussi avoir la possibilité de définir la longueur
de
la clé et quelles caractères je désire utiliser (par exemple 0 et O étant
similaire, pouvoir enlever l'un des deux. le resultat devrais etre sous
form
d'un tableaud'une colonne et d'un grand nombre de ligne (pour faire un
merge
avec word et produire les coupons en PDF pour l'imprimeur)
J'avais ca l'année dernière mais j'ai perdue la feuille Excel :(
Amitiés
Thierry
Dans cette section de la macro :
With .Range("d2:d" & .Range("d256").End(xlUp).Row)
If .Rows.Count = 1 Or _
.Count <> Application.CountA(.Value) Then
MsgBox "Errors in the characteres list."
Exit Sub
'******Effectivement j'avais oublié ceci **********
else
arr = .value 'cette ligne définie le tableau
'**************************************************
End If
End With
"Thierry Schweitzer" a écrit dans le
message de groupe de
discussion :
Michel
De retour, bon bien ca marche pas :(
Dans feuille "variables"
pour le nombre de digits B2 = 12
le nombre de fois à generer B3 = 10
la feuille de resultat B4 = Random chain (une feuille existe et j'ai
copier
coller son nom pour etre sure)
Adress de la premiere cellule de resultat B5 = A1
Dans D2 a D255 il n'y a rien sauf dans les 12 premiere ligne ou il y a des
caracteres de type lettre et chiffre qui sont tous uniques
j'ai creer un bouton, attachée la macro, si je click dessus excel par, je
pense en boucle, et je suis obliger de le fermer de force
pourquoi ??
'---------------------------------------------------------
Sub Chaine_Caracteres_au_hasard2()
Dim A As Long, B As Long, I As Long, X As Integer
Dim Arr(), N As Long, NbCar As Integer
Dim D As Object, Texte As String
Dim NomFeuille As String, Adr As String
Dim Sh As Worksheet, Rg As Range
'********* Variables à renseigner **************
'variables sont dans les cellules de la feuil1
With Worksheets("variables")
'Nombre de caractères de chacune des chaînes
'Un petit test afin de t'assurer qu'elles ont
'au moins un caractère mais pas plus de 1000
If .Range("B2") > 0 And .Range("B2") <= 1000 Then
NbCar = .Range("B2")
Else
MsgBox "the value un B2 is out limits of 1-1000 "
Exit Sub
End If
'Nombre de chaînes désirées
If .Range("B3") > 0 And .Range("B3") <= 65000 Then
N = .Range("B3")
Else
MsgBox "the maxi number of chain is 1-65500"
Exit Sub
End If
'Nom onglet feuille où sera copié le résultat
NomFeuille = .Range("B4")
On Error Resume Next
Set Sh = Worksheets(NomFeuille)
If Err <> 0 Then
Err = 0
MsgBox "the sheet with that name does " & _
"not exists operation aborted."
Exit Sub
End If
'Adresse de la première cellule
'où le résultat sera copié.
Adr = .Range("B5")
Set Rg = Worksheets(NomFeuille).Range(Adr)
If Err <> 0 Then
Err = 0
MsgBox "Destination cell adress is wrong " & _
"operation aborted."
Exit Sub
End If
'Plage de cellules listant séparément (1 par cellule)
'la liste des caractères faisant parti du tirage.
'Il ne doit pas y avoir de cellules vides car tu auras
'des "vides" dans les chaînes créées.
With .Range("d2:d" & .Range("d256").End(xlUp).Row)
If .Rows.Count = 1 Or _
.Count <> Application.CountA(.Value) Then
MsgBox "Errors in the characteres list."
Exit Sub
End If
End With
End With
'***************************************************
I = 0
Set D = CreateObject("Scripting.Dictionary")
Do Until I = N
For X = 1 To NbCar
Randomize
Texte = Texte & Arr(Int((UBound(Arr, 1) - _
LBound(Arr, 1) + 1) * Rnd + LBound(Arr, 1)), 1)
Next
If Not D.Exists(Texte) Then
D.Add Texte, Texte
I = I + 1
End If
Texte = ""
Loop
With Sheets(NomFeuille)
.Range(Adr).NumberFormat = "@"
.Range(Adr).Resize(N) = Application.Transpose(D.Items)
End With
End Sub
'---------------------------------------------------------
"MichDenis" a écrit dans le message de news:Bonjour Thierry,
Voilà la macro devrait s'exécuter normalement.
En lisant les commentaires, tu devrais trouver
comment renseigner les variables. Le nom
des feuilles, et chacune des adresses des cellules
relèvent de ton choix.
'---------------------------------------------------------
Sub Chaine_Caracteres_au_hasard()
Dim A As Long, B As Long, I As Long, X As Integer
Dim Arr(), N As Long, NbCar As Integer
Dim D As Object, Texte As String
Dim NomFeuille As String, Adr As String
Dim Sh As Worksheet, Rg As Range
'********* Variables à renseigner **************
'variables sont dans les cellules de la feuil1
With Worksheets("Feuil1")
'Nombre de caractères de chacune des chaînes
'Un petit test afin de t'assurer qu'elles ont
'au moins un caractère mais pas plus de 10
If .Range("B1") > 0 And .Range("B1") <= 10 Then
NbCar = .Range("B1")
Else
MsgBox "L'info en B1 est en dehors des " & _
"limites permises. Corriger."
Exit Sub
End If
'Nombre de chaînes désirées
If .Range("B1") > 0 And .Range("B1") <= 10000 Then
N = .Range("B2")
Else
MsgBox "Le nombre de chaîne se situe en " & _
"dehors de la limite 1- 10000."
Exit Sub
End If
'Nom onglet feuille où sera copié le résultat
NomFeuille = .Range("B3")
On Error Resume Next
Set Sh = Worksheets(NomFeuille)
If Err <> 0 Then
Err = 0
MsgBox "le nom de la feuille de destination " & _
"n'existe pas. opération annulée."
Exit Sub
End If
'Adresse de la première cellule
'où le résultat sera copié.
Adr = .Range("B4")
Set Rg = Worksheets(NomFeuille).Range(Adr)
If Err <> 0 Then
Err = 0
MsgBox "L'adresse de la cellule de destination " & _
"est incorrecte. opération annulée."
Exit Sub
End If
'Plage de cellules listant séparément (1 par cellule)
'la liste des caractères faisant parti du tirage.
'Il ne doit pas y avoir de cellules vides car tu auras
'des "vides" dans les chaînes créées.
With .Range("A1:A" & .Range("A65536").End(xlUp).Row)
If .Rows.Count = 1 Or _
.Count <> Application.CountA(.Value) Then
MsgBox "Irrégularités dans la liste des " & _
"symboles disponibles pour la création des chaînes."
Exit Sub
End If
End With
End With
'***************************************************
I = 0
Set D = CreateObject("Scripting.Dictionary")
Do Until I = N
For X = 1 To NbCar
Randomize
Texte = Texte & Arr(Int((UBound(Arr, 1) - _
LBound(Arr, 1) + 1) * Rnd + LBound(Arr, 1)), 1)
Next
If Not D.Exists(Texte) Then
D.Add Texte, Texte
I = I + 1
End If
Texte = ""
Loop
With Sheets(NomFeuille)
.Range(Adr).NumberFormat = "@"
.Range(Adr).Resize(N) = Application.Transpose(D.Items)
End With
End Sub
'---------------------------------------------------------
"Thierry Schweitzer" a écrit dans le
message de groupe de
discussion : #
Superbe
elle marche super bien la macro
par contre serais t'il possible d'appeler les variables de la fille elle
meme, ou d'une autre feuille.
ciomme je desire faire remonter cette feuille au siege de mon
organisation
pour etre utiliser ailleurs, renter dans un page de code visual basic,
n'est
pas à la porté de tout le monde !!
donc par example dans une page utilitée "variable"
avoir les cellule B2, B3 etc...
donc en faite pour que je fasse quant meme quelque chose
'********* Variables à renseigner **************
NbCar = 10 'Nombre de caractères par chaîne
N = 1000 'Nombre de chaînes différentes
'que la procédure doit générer
NomFeuille = "Feuil1" ' nom de l'onglet de la feuille
'où la liste sera inscrite
Adr = "A1" ' Adresse de la première cellule
' où débutera la liste
'***************************************************
Comment appeler la cellule B2 de la page "Variable" pour informer la
valeur
NbCar, et ainsi de suite ?? Si c'est possible
merci encore
Thierry
"MichDenis" a écrit dans le message de news:Bonjour Thierry,
Il ne te reste plus qu'à définir les variables selon tes besoins :
'---------------------------------------------------------
Sub Chaine_Caracteres_au_hasard()
Dim A As Long, B As Long, I As Long, X As Integer
Dim Arr(), N As Long, NbCar As Integer
Dim D As Object, Texte As String
Dim NomFeuille As String, Adr As String
'Liste des caractères possible :
Arr = Array("A", "B", "C", "D", "E", "F", "G", "H", _
"I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", _
"S", "T", "U", "V", "W", "X", "Y", "Z", 0, 1, 2, _
3, 4, 5, 6, 7, 8, 9)
'********* Variables à renseigner **************
NbCar = 10 'Nombre de caractères par chaîne
N = 1000 'Nombre de chaînes différentes
'que la procédure doit générer
NomFeuille = "Feuil1" ' nom de l'onglet de la feuille
'où la liste sera inscrite
Adr = "A1" ' Adresse de la première cellule
' où débutera la liste
'***************************************************
I = 0
Set D = CreateObject("Scripting.Dictionary")
Do Until I = N
For X = 1 To NbCar
Randomize
Texte = Texte & Arr(Int((UBound(Arr) - _
LBound(Arr) + 1) * Rnd + LBound(Arr)))
Next
If Not D.Exists(Texte) Then
D.Add Texte, Texte
I = I + 1
End If
Texte = ""
Loop
With Sheets(NomFeuille)
.Range(Adr).NumberFormat = "@"
.Range(Adr).Resize(N) = Application.Transpose(D.Items)
End With
End Sub
'---------------------------------------------------------
"Thierry Schweitzer" a écrit dans le
message de groupe de
discussion :
Bonjour
j'ai besoins de pouvoir générer des clés uniques pour faire des coupons
de
distribution (je travaille dans l'humanitaire)
je voudrais donc avec tout les lettres de l'alphabet et les 10 chiffres
mélangés au hasard et si possible que la chaine de charactere générée
soit
unique
Si possible j'aimerais aussi avoir la possibilité de définir la longueur
de
la clé et quelles caractères je désire utiliser (par exemple 0 et O
étant
similaire, pouvoir enlever l'un des deux. le resultat devrais etre sous
form
d'un tableaud'une colonne et d'un grand nombre de ligne (pour faire un
merge
avec word et produire les coupons en PDF pour l'imprimeur)
J'avais ca l'année dernière mais j'ai perdue la feuille Excel :(
Amitiés
Thierry
Dans cette section de la macro :
With .Range("d2:d" & .Range("d256").End(xlUp).Row)
If .Rows.Count = 1 Or _
.Count <> Application.CountA(.Value) Then
MsgBox "Errors in the characteres list."
Exit Sub
'******Effectivement j'avais oublié ceci **********
else
arr = .value 'cette ligne définie le tableau
'**************************************************
End If
End With
"Thierry Schweitzer" <thierry.schweitzer@gmail.com> a écrit dans le
message de groupe de
discussion : ulmZNlFuJHA.1304@TK2MSFTNGP05.phx.gbl...
Michel
De retour, bon bien ca marche pas :(
Dans feuille "variables"
pour le nombre de digits B2 = 12
le nombre de fois à generer B3 = 10
la feuille de resultat B4 = Random chain (une feuille existe et j'ai
copier
coller son nom pour etre sure)
Adress de la premiere cellule de resultat B5 = A1
Dans D2 a D255 il n'y a rien sauf dans les 12 premiere ligne ou il y a des
caracteres de type lettre et chiffre qui sont tous uniques
j'ai creer un bouton, attachée la macro, si je click dessus excel par, je
pense en boucle, et je suis obliger de le fermer de force
pourquoi ??
'---------------------------------------------------------
Sub Chaine_Caracteres_au_hasard2()
Dim A As Long, B As Long, I As Long, X As Integer
Dim Arr(), N As Long, NbCar As Integer
Dim D As Object, Texte As String
Dim NomFeuille As String, Adr As String
Dim Sh As Worksheet, Rg As Range
'********* Variables à renseigner **************
'variables sont dans les cellules de la feuil1
With Worksheets("variables")
'Nombre de caractères de chacune des chaînes
'Un petit test afin de t'assurer qu'elles ont
'au moins un caractère mais pas plus de 1000
If .Range("B2") > 0 And .Range("B2") <= 1000 Then
NbCar = .Range("B2")
Else
MsgBox "the value un B2 is out limits of 1-1000 "
Exit Sub
End If
'Nombre de chaînes désirées
If .Range("B3") > 0 And .Range("B3") <= 65000 Then
N = .Range("B3")
Else
MsgBox "the maxi number of chain is 1-65500"
Exit Sub
End If
'Nom onglet feuille où sera copié le résultat
NomFeuille = .Range("B4")
On Error Resume Next
Set Sh = Worksheets(NomFeuille)
If Err <> 0 Then
Err = 0
MsgBox "the sheet with that name does " & _
"not exists operation aborted."
Exit Sub
End If
'Adresse de la première cellule
'où le résultat sera copié.
Adr = .Range("B5")
Set Rg = Worksheets(NomFeuille).Range(Adr)
If Err <> 0 Then
Err = 0
MsgBox "Destination cell adress is wrong " & _
"operation aborted."
Exit Sub
End If
'Plage de cellules listant séparément (1 par cellule)
'la liste des caractères faisant parti du tirage.
'Il ne doit pas y avoir de cellules vides car tu auras
'des "vides" dans les chaînes créées.
With .Range("d2:d" & .Range("d256").End(xlUp).Row)
If .Rows.Count = 1 Or _
.Count <> Application.CountA(.Value) Then
MsgBox "Errors in the characteres list."
Exit Sub
End If
End With
End With
'***************************************************
I = 0
Set D = CreateObject("Scripting.Dictionary")
Do Until I = N
For X = 1 To NbCar
Randomize
Texte = Texte & Arr(Int((UBound(Arr, 1) - _
LBound(Arr, 1) + 1) * Rnd + LBound(Arr, 1)), 1)
Next
If Not D.Exists(Texte) Then
D.Add Texte, Texte
I = I + 1
End If
Texte = ""
Loop
With Sheets(NomFeuille)
.Range(Adr).NumberFormat = "@"
.Range(Adr).Resize(N) = Application.Transpose(D.Items)
End With
End Sub
'---------------------------------------------------------
"MichDenis" <michdenis@hotmail.com> a écrit dans le message de news:
29D1C01D-D796-4A1C-B8BC-EDE24D6BD878@microsoft.com...
Bonjour Thierry,
Voilà la macro devrait s'exécuter normalement.
En lisant les commentaires, tu devrais trouver
comment renseigner les variables. Le nom
des feuilles, et chacune des adresses des cellules
relèvent de ton choix.
'---------------------------------------------------------
Sub Chaine_Caracteres_au_hasard()
Dim A As Long, B As Long, I As Long, X As Integer
Dim Arr(), N As Long, NbCar As Integer
Dim D As Object, Texte As String
Dim NomFeuille As String, Adr As String
Dim Sh As Worksheet, Rg As Range
'********* Variables à renseigner **************
'variables sont dans les cellules de la feuil1
With Worksheets("Feuil1")
'Nombre de caractères de chacune des chaînes
'Un petit test afin de t'assurer qu'elles ont
'au moins un caractère mais pas plus de 10
If .Range("B1") > 0 And .Range("B1") <= 10 Then
NbCar = .Range("B1")
Else
MsgBox "L'info en B1 est en dehors des " & _
"limites permises. Corriger."
Exit Sub
End If
'Nombre de chaînes désirées
If .Range("B1") > 0 And .Range("B1") <= 10000 Then
N = .Range("B2")
Else
MsgBox "Le nombre de chaîne se situe en " & _
"dehors de la limite 1- 10000."
Exit Sub
End If
'Nom onglet feuille où sera copié le résultat
NomFeuille = .Range("B3")
On Error Resume Next
Set Sh = Worksheets(NomFeuille)
If Err <> 0 Then
Err = 0
MsgBox "le nom de la feuille de destination " & _
"n'existe pas. opération annulée."
Exit Sub
End If
'Adresse de la première cellule
'où le résultat sera copié.
Adr = .Range("B4")
Set Rg = Worksheets(NomFeuille).Range(Adr)
If Err <> 0 Then
Err = 0
MsgBox "L'adresse de la cellule de destination " & _
"est incorrecte. opération annulée."
Exit Sub
End If
'Plage de cellules listant séparément (1 par cellule)
'la liste des caractères faisant parti du tirage.
'Il ne doit pas y avoir de cellules vides car tu auras
'des "vides" dans les chaînes créées.
With .Range("A1:A" & .Range("A65536").End(xlUp).Row)
If .Rows.Count = 1 Or _
.Count <> Application.CountA(.Value) Then
MsgBox "Irrégularités dans la liste des " & _
"symboles disponibles pour la création des chaînes."
Exit Sub
End If
End With
End With
'***************************************************
I = 0
Set D = CreateObject("Scripting.Dictionary")
Do Until I = N
For X = 1 To NbCar
Randomize
Texte = Texte & Arr(Int((UBound(Arr, 1) - _
LBound(Arr, 1) + 1) * Rnd + LBound(Arr, 1)), 1)
Next
If Not D.Exists(Texte) Then
D.Add Texte, Texte
I = I + 1
End If
Texte = ""
Loop
With Sheets(NomFeuille)
.Range(Adr).NumberFormat = "@"
.Range(Adr).Resize(N) = Application.Transpose(D.Items)
End With
End Sub
'---------------------------------------------------------
"Thierry Schweitzer" <thierry.schweitzer@gmail.com> a écrit dans le
message de groupe de
discussion : #GzrQ8DuJHA.2596@TK2MSFTNGP02.phx.gbl...
Superbe
elle marche super bien la macro
par contre serais t'il possible d'appeler les variables de la fille elle
meme, ou d'une autre feuille.
ciomme je desire faire remonter cette feuille au siege de mon
organisation
pour etre utiliser ailleurs, renter dans un page de code visual basic,
n'est
pas à la porté de tout le monde !!
donc par example dans une page utilitée "variable"
avoir les cellule B2, B3 etc...
donc en faite pour que je fasse quant meme quelque chose
'********* Variables à renseigner **************
NbCar = 10 'Nombre de caractères par chaîne
N = 1000 'Nombre de chaînes différentes
'que la procédure doit générer
NomFeuille = "Feuil1" ' nom de l'onglet de la feuille
'où la liste sera inscrite
Adr = "A1" ' Adresse de la première cellule
' où débutera la liste
'***************************************************
Comment appeler la cellule B2 de la page "Variable" pour informer la
valeur
NbCar, et ainsi de suite ?? Si c'est possible
merci encore
Thierry
"MichDenis" <michdenis@hotmail.com> a écrit dans le message de news:
EBD2036D-C6E1-477D-BE3E-AD2853D8DC83@microsoft.com...
Bonjour Thierry,
Il ne te reste plus qu'à définir les variables selon tes besoins :
'---------------------------------------------------------
Sub Chaine_Caracteres_au_hasard()
Dim A As Long, B As Long, I As Long, X As Integer
Dim Arr(), N As Long, NbCar As Integer
Dim D As Object, Texte As String
Dim NomFeuille As String, Adr As String
'Liste des caractères possible :
Arr = Array("A", "B", "C", "D", "E", "F", "G", "H", _
"I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", _
"S", "T", "U", "V", "W", "X", "Y", "Z", 0, 1, 2, _
3, 4, 5, 6, 7, 8, 9)
'********* Variables à renseigner **************
NbCar = 10 'Nombre de caractères par chaîne
N = 1000 'Nombre de chaînes différentes
'que la procédure doit générer
NomFeuille = "Feuil1" ' nom de l'onglet de la feuille
'où la liste sera inscrite
Adr = "A1" ' Adresse de la première cellule
' où débutera la liste
'***************************************************
I = 0
Set D = CreateObject("Scripting.Dictionary")
Do Until I = N
For X = 1 To NbCar
Randomize
Texte = Texte & Arr(Int((UBound(Arr) - _
LBound(Arr) + 1) * Rnd + LBound(Arr)))
Next
If Not D.Exists(Texte) Then
D.Add Texte, Texte
I = I + 1
End If
Texte = ""
Loop
With Sheets(NomFeuille)
.Range(Adr).NumberFormat = "@"
.Range(Adr).Resize(N) = Application.Transpose(D.Items)
End With
End Sub
'---------------------------------------------------------
"Thierry Schweitzer" <thierry.schweitzer@gmail.com> a écrit dans le
message de groupe de
discussion : e5WjcpetJHA.4980@TK2MSFTNGP02.phx.gbl...
Bonjour
j'ai besoins de pouvoir générer des clés uniques pour faire des coupons
de
distribution (je travaille dans l'humanitaire)
je voudrais donc avec tout les lettres de l'alphabet et les 10 chiffres
mélangés au hasard et si possible que la chaine de charactere générée
soit
unique
Si possible j'aimerais aussi avoir la possibilité de définir la longueur
de
la clé et quelles caractères je désire utiliser (par exemple 0 et O
étant
similaire, pouvoir enlever l'un des deux. le resultat devrais etre sous
form
d'un tableaud'une colonne et d'un grand nombre de ligne (pour faire un
merge
avec word et produire les coupons en PDF pour l'imprimeur)
J'avais ca l'année dernière mais j'ai perdue la feuille Excel :(
Amitiés
Thierry
Dans cette section de la macro :
With .Range("d2:d" & .Range("d256").End(xlUp).Row)
If .Rows.Count = 1 Or _
.Count <> Application.CountA(.Value) Then
MsgBox "Errors in the characteres list."
Exit Sub
'******Effectivement j'avais oublié ceci **********
else
arr = .value 'cette ligne définie le tableau
'**************************************************
End If
End With
"Thierry Schweitzer" a écrit dans le
message de groupe de
discussion :
Michel
De retour, bon bien ca marche pas :(
Dans feuille "variables"
pour le nombre de digits B2 = 12
le nombre de fois à generer B3 = 10
la feuille de resultat B4 = Random chain (une feuille existe et j'ai
copier
coller son nom pour etre sure)
Adress de la premiere cellule de resultat B5 = A1
Dans D2 a D255 il n'y a rien sauf dans les 12 premiere ligne ou il y a des
caracteres de type lettre et chiffre qui sont tous uniques
j'ai creer un bouton, attachée la macro, si je click dessus excel par, je
pense en boucle, et je suis obliger de le fermer de force
pourquoi ??
'---------------------------------------------------------
Sub Chaine_Caracteres_au_hasard2()
Dim A As Long, B As Long, I As Long, X As Integer
Dim Arr(), N As Long, NbCar As Integer
Dim D As Object, Texte As String
Dim NomFeuille As String, Adr As String
Dim Sh As Worksheet, Rg As Range
'********* Variables à renseigner **************
'variables sont dans les cellules de la feuil1
With Worksheets("variables")
'Nombre de caractères de chacune des chaînes
'Un petit test afin de t'assurer qu'elles ont
'au moins un caractère mais pas plus de 1000
If .Range("B2") > 0 And .Range("B2") <= 1000 Then
NbCar = .Range("B2")
Else
MsgBox "the value un B2 is out limits of 1-1000 "
Exit Sub
End If
'Nombre de chaînes désirées
If .Range("B3") > 0 And .Range("B3") <= 65000 Then
N = .Range("B3")
Else
MsgBox "the maxi number of chain is 1-65500"
Exit Sub
End If
'Nom onglet feuille où sera copié le résultat
NomFeuille = .Range("B4")
On Error Resume Next
Set Sh = Worksheets(NomFeuille)
If Err <> 0 Then
Err = 0
MsgBox "the sheet with that name does " & _
"not exists operation aborted."
Exit Sub
End If
'Adresse de la première cellule
'où le résultat sera copié.
Adr = .Range("B5")
Set Rg = Worksheets(NomFeuille).Range(Adr)
If Err <> 0 Then
Err = 0
MsgBox "Destination cell adress is wrong " & _
"operation aborted."
Exit Sub
End If
'Plage de cellules listant séparément (1 par cellule)
'la liste des caractères faisant parti du tirage.
'Il ne doit pas y avoir de cellules vides car tu auras
'des "vides" dans les chaînes créées.
With .Range("d2:d" & .Range("d256").End(xlUp).Row)
If .Rows.Count = 1 Or _
.Count <> Application.CountA(.Value) Then
MsgBox "Errors in the characteres list."
Exit Sub
End If
End With
End With
'***************************************************
I = 0
Set D = CreateObject("Scripting.Dictionary")
Do Until I = N
For X = 1 To NbCar
Randomize
Texte = Texte & Arr(Int((UBound(Arr, 1) - _
LBound(Arr, 1) + 1) * Rnd + LBound(Arr, 1)), 1)
Next
If Not D.Exists(Texte) Then
D.Add Texte, Texte
I = I + 1
End If
Texte = ""
Loop
With Sheets(NomFeuille)
.Range(Adr).NumberFormat = "@"
.Range(Adr).Resize(N) = Application.Transpose(D.Items)
End With
End Sub
'---------------------------------------------------------
"MichDenis" a écrit dans le message de news:Bonjour Thierry,
Voilà la macro devrait s'exécuter normalement.
En lisant les commentaires, tu devrais trouver
comment renseigner les variables. Le nom
des feuilles, et chacune des adresses des cellules
relèvent de ton choix.
'---------------------------------------------------------
Sub Chaine_Caracteres_au_hasard()
Dim A As Long, B As Long, I As Long, X As Integer
Dim Arr(), N As Long, NbCar As Integer
Dim D As Object, Texte As String
Dim NomFeuille As String, Adr As String
Dim Sh As Worksheet, Rg As Range
'********* Variables à renseigner **************
'variables sont dans les cellules de la feuil1
With Worksheets("Feuil1")
'Nombre de caractères de chacune des chaînes
'Un petit test afin de t'assurer qu'elles ont
'au moins un caractère mais pas plus de 10
If .Range("B1") > 0 And .Range("B1") <= 10 Then
NbCar = .Range("B1")
Else
MsgBox "L'info en B1 est en dehors des " & _
"limites permises. Corriger."
Exit Sub
End If
'Nombre de chaînes désirées
If .Range("B1") > 0 And .Range("B1") <= 10000 Then
N = .Range("B2")
Else
MsgBox "Le nombre de chaîne se situe en " & _
"dehors de la limite 1- 10000."
Exit Sub
End If
'Nom onglet feuille où sera copié le résultat
NomFeuille = .Range("B3")
On Error Resume Next
Set Sh = Worksheets(NomFeuille)
If Err <> 0 Then
Err = 0
MsgBox "le nom de la feuille de destination " & _
"n'existe pas. opération annulée."
Exit Sub
End If
'Adresse de la première cellule
'où le résultat sera copié.
Adr = .Range("B4")
Set Rg = Worksheets(NomFeuille).Range(Adr)
If Err <> 0 Then
Err = 0
MsgBox "L'adresse de la cellule de destination " & _
"est incorrecte. opération annulée."
Exit Sub
End If
'Plage de cellules listant séparément (1 par cellule)
'la liste des caractères faisant parti du tirage.
'Il ne doit pas y avoir de cellules vides car tu auras
'des "vides" dans les chaînes créées.
With .Range("A1:A" & .Range("A65536").End(xlUp).Row)
If .Rows.Count = 1 Or _
.Count <> Application.CountA(.Value) Then
MsgBox "Irrégularités dans la liste des " & _
"symboles disponibles pour la création des chaînes."
Exit Sub
End If
End With
End With
'***************************************************
I = 0
Set D = CreateObject("Scripting.Dictionary")
Do Until I = N
For X = 1 To NbCar
Randomize
Texte = Texte & Arr(Int((UBound(Arr, 1) - _
LBound(Arr, 1) + 1) * Rnd + LBound(Arr, 1)), 1)
Next
If Not D.Exists(Texte) Then
D.Add Texte, Texte
I = I + 1
End If
Texte = ""
Loop
With Sheets(NomFeuille)
.Range(Adr).NumberFormat = "@"
.Range(Adr).Resize(N) = Application.Transpose(D.Items)
End With
End Sub
'---------------------------------------------------------
"Thierry Schweitzer" a écrit dans le
message de groupe de
discussion : #
Superbe
elle marche super bien la macro
par contre serais t'il possible d'appeler les variables de la fille elle
meme, ou d'une autre feuille.
ciomme je desire faire remonter cette feuille au siege de mon
organisation
pour etre utiliser ailleurs, renter dans un page de code visual basic,
n'est
pas à la porté de tout le monde !!
donc par example dans une page utilitée "variable"
avoir les cellule B2, B3 etc...
donc en faite pour que je fasse quant meme quelque chose
'********* Variables à renseigner **************
NbCar = 10 'Nombre de caractères par chaîne
N = 1000 'Nombre de chaînes différentes
'que la procédure doit générer
NomFeuille = "Feuil1" ' nom de l'onglet de la feuille
'où la liste sera inscrite
Adr = "A1" ' Adresse de la première cellule
' où débutera la liste
'***************************************************
Comment appeler la cellule B2 de la page "Variable" pour informer la
valeur
NbCar, et ainsi de suite ?? Si c'est possible
merci encore
Thierry
"MichDenis" a écrit dans le message de news:Bonjour Thierry,
Il ne te reste plus qu'à définir les variables selon tes besoins :
'---------------------------------------------------------
Sub Chaine_Caracteres_au_hasard()
Dim A As Long, B As Long, I As Long, X As Integer
Dim Arr(), N As Long, NbCar As Integer
Dim D As Object, Texte As String
Dim NomFeuille As String, Adr As String
'Liste des caractères possible :
Arr = Array("A", "B", "C", "D", "E", "F", "G", "H", _
"I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", _
"S", "T", "U", "V", "W", "X", "Y", "Z", 0, 1, 2, _
3, 4, 5, 6, 7, 8, 9)
'********* Variables à renseigner **************
NbCar = 10 'Nombre de caractères par chaîne
N = 1000 'Nombre de chaînes différentes
'que la procédure doit générer
NomFeuille = "Feuil1" ' nom de l'onglet de la feuille
'où la liste sera inscrite
Adr = "A1" ' Adresse de la première cellule
' où débutera la liste
'***************************************************
I = 0
Set D = CreateObject("Scripting.Dictionary")
Do Until I = N
For X = 1 To NbCar
Randomize
Texte = Texte & Arr(Int((UBound(Arr) - _
LBound(Arr) + 1) * Rnd + LBound(Arr)))
Next
If Not D.Exists(Texte) Then
D.Add Texte, Texte
I = I + 1
End If
Texte = ""
Loop
With Sheets(NomFeuille)
.Range(Adr).NumberFormat = "@"
.Range(Adr).Resize(N) = Application.Transpose(D.Items)
End With
End Sub
'---------------------------------------------------------
"Thierry Schweitzer" a écrit dans le
message de groupe de
discussion :
Bonjour
j'ai besoins de pouvoir générer des clés uniques pour faire des coupons
de
distribution (je travaille dans l'humanitaire)
je voudrais donc avec tout les lettres de l'alphabet et les 10 chiffres
mélangés au hasard et si possible que la chaine de charactere générée
soit
unique
Si possible j'aimerais aussi avoir la possibilité de définir la longueur
de
la clé et quelles caractères je désire utiliser (par exemple 0 et O
étant
similaire, pouvoir enlever l'un des deux. le resultat devrais etre sous
form
d'un tableaud'une colonne et d'un grand nombre de ligne (pour faire un
merge
avec word et produire les coupons en PDF pour l'imprimeur)
J'avais ca l'année dernière mais j'ai perdue la feuille Excel :(
Amitiés
Thierry