Creer un ID unique via macro

Pouetpouet72 · 18 Septembre 2010

Bonjour a tous,

Je fait une nouvelle fois appelle à vous pour un probleme que je n'arrive pas à reseoudre après moulte recherches qui ne me conviennent pas 🙁

Je souhaiterai dans une colonne generer une valeur unique (correspondant à une sorte d'index) de la forme Uxxxx ou xxxx sont des chiffres.

La particularité c'est qu'il me faut integrer ceci dans une macro (dc via un bouton qui remplirai la cellule) et que l'argument utilisé NE SOIT PAS prendre la cellule du dessus et l'incrementer de 1 mais plutot lire toute la colonne, reperer la valeur maximum et l'incrementer de 1, ceci dans un souci de tri de la premiere colonne (les index bougeront donc).

Voici un exemple de ce que je souhaite mettre en place :

Dans mon image de gauche, le bouton m'a permis de creer les index. apres un tri (donc id dans le desordre) et l'ajout d'une valeur en dessous, le bouton a reperer la valeur maximale (U0004) et a donc creer U0005 pour le suivant.

Auriez-vous une solution pour moi ?

En vous remerciant par avance 😎

Habitude · 18 Septembre 2010

Re : Creer un ID unique via macro

Garder dans une cellule
Blanc sur fond blanc
La valeur du dernier ID générer.
Et utiliser ce chiffre +1 pour le nouvel ID.

JNP · 18 Septembre 2010

Re : Creer un ID unique via macro

Bonjour le fil 🙂,
Personnellement, je passerais par un format personalisé et une événementielle 😉.
Voir fichier joint, il suffit de saisir un nom dans la colonne A et de valider 😛.
D'ailleurs, un petit fichier au lieu d'un JPG m'aurait fait gagner du temps 😀.
Bon WE 😎

ROGER2327 · 18 Septembre 2010

Re : Creer un ID unique via macro

Bonjour à tous

Une proposition engendrant des identifiants de la forme U####. Laissez le format de la colonne des identifiants au format Standard.
La procédure est paramétrable. Elle permet de traiter plusieurs lignes en une passe (collage d'une plage, par exemple).

Code:

[COLOR="DarkSlateGray"][B]Private Sub Worksheet_Change(ByVal Target As Range)
Dim Nom%, IDn%
Dim n&, oPlg As Object, oCel As Range
   Nom = 1 [COLOR="SeaGreen"]'rang de la colonne des Noms[/COLOR]
   IDn = 2 [COLOR="SeaGreen"]'rang de la colonne des IDnentifiants[/COLOR]
   Set oPlg = Intersect(Target, Columns(Nom).Resize(Rows.Count - 1, 1).Offset(1, 0))
   If Not oPlg Is Nothing Then
      With Range(Cells(1, IDn), Cells(Rows.Count, IDn).End(xlUp))
         For Each oCel In .Cells
            If oCel.Value Like "U####" Then n = WorksheetFunction.Max(n, Val(Right$(oCel.Value, 4)))
         Next oCel
      End With
      Application.Calculation = xlCalculationManual
      For Each oCel In oPlg.Cells
         If IsEmpty(oCel.Offset(0, IDn - Nom)) And Not IsEmpty(oCel) Then
            n = n + 1
            Application.EnableEvents = False
            oCel.Offset(0, IDn - Nom).Value = "U" & Format(n, "0000")
            Application.EnableEvents = True
         End If
      Next oCel
      Application.Calculation = xlCalculationAutomatic
   End If
   Set oPlg = Nothing
End Sub[/B][/COLOR]

ROGER2327
#4146

Mercredi 11 Absolu 138 (Sainte Purée, sportswoman, SQ)
2ème Sanculottide An CCXVIII
2010-W37-6T09:27:36Z

JNP · 18 Septembre 2010

Re : Creer un ID unique via macro

Bonjour Roger 🙂,
Effectivement, la gestion d'une plage de plus d'une ligne est intéressante 😉.

Code:

[COLOR=blue]Private Sub[/COLOR] Worksheet_Change([COLOR=blue]ByVal[/COLOR] Target [COLOR=blue]As[/COLOR] Range)
[COLOR=blue]Dim[/COLOR] I [COLOR=blue]As Integer[/COLOR]
[COLOR=blue]If[/COLOR] Target.Column > 1 [COLOR=blue]Then Exit Sub[/COLOR]
[COLOR=blue]For[/COLOR] I = Target.Row [COLOR=blue]To[/COLOR] Target.Row + Target.Rows.Count - 1
[COLOR=blue]If[/COLOR] Cells(I, 2) = "" [COLOR=blue]And[/COLOR] Cells(I, 1) <> "" [COLOR=blue]Then[/COLOR]
Cells(I, 2) = WorksheetFunction.Max(Range("B2:B" & Range("B65536").End(xlUp).Row)) + 1
[COLOR=blue]End If[/COLOR]
[COLOR=blue]Next[/COLOR] I
[COLOR=blue]End Sub[/COLOR]

mon code précédent corrigé ainsi permettra aussi le copier/coller.
Bon WE 😎

Pouetpouet72 · 18 Septembre 2010

Re : Creer un ID unique via macro

Que dire ???? vous etes trop forts !! 😀

C'est exactement ce que je cherchai à faire, vous êtes mes sauveurs.

Un enorme merci à vous pour avoir daigner vous pencher sur mon pb, les forums d'entraide prennent tout leurs sens grace à des personnes comme vous.

Bonne journée à vous 😎

ROGER2327 · 18 Septembre 2010

Re : Creer un ID unique via macro

Re...

Pouetpouet72 à dit:
(...)
C'est exactement ce que je cherchai à faire, vous êtes mes sauveurs.
(...)

Tant mieux !

Mais voici quelque chose de plus sérieux :

Code:

[COLOR="DarkSlateGray"][B]Option Explicit

Const nMax& = 0 [COLOR="Red"]'Cette ligne doit être TOUJOURS la troisième ligne du module.[/COLOR]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Nom%, IDn%
Dim n&, oPlg As Object, oCel As Range, oColl As New Collection
   Nom = 1 [COLOR="YellowGreen"]'rang de la colonne des Noms[/COLOR]
   IDn = 2 [COLOR="YellowGreen"]'rang de la colonne des Identifiants[/COLOR]
   n = nMax
   Set oPlg = Intersect(Target, Columns(Nom).Resize(Rows.Count - 1, 1).Offset(1, 0))
   If Not oPlg Is Nothing Then
      With Range(Cells(1, IDn), Cells(Rows.Count, IDn).End(xlUp))
         For Each oCel In .Cells
            If oCel.Value Like "U####" Then
               On Error Resume Next
               oColl.Add Item:=oCel.Value, Key:=CStr(oCel.Value)
               If Err.Number <> 0 Then GoTo E
               On Error GoTo 0
               n = WorksheetFunction.Max(n, Val(Right$(oCel.Value, 4)))
            End If
         Next oCel
      End With
      Application.Calculation = xlCalculationManual
      For Each oCel In oPlg.Cells
         If n = 9999 Then MsgBox "Tous les identifiants ont été attribués." & vbLf & "Désolé...": Exit For
         If IsEmpty(oCel.Offset(0, IDn - Nom)) And Not IsEmpty(oCel) Then
            n = n + 1
            Application.EnableEvents = False
            oCel.Offset(0, IDn - Nom).Value = "U" & Format(n, "0000")
            Application.EnableEvents = True
         End If
      Next oCel
      ThisWorkbook.VBProject.VBComponents(Me.CodeName).CodeModule.ReplaceLine 3, "Const nMax = " & n & "'Cette ligne doit être TOUJOURS la troisième ligne du module."
S:    Application.Calculation = xlCalculationAutomatic
   End If
   Set oPlg = Nothing
Exit Sub
E: MsgBox "L'identifiant " & oCel.Value & " n'est pas unique." & vbLf & "Vérifier la colonne " & IDn & "."
   Err.Number = 0
   Resume S
End Sub[/B][/COLOR]

La procédure avertit de la présence d'un doublon dans la colonne des identifiants. (Ce qui peut arriver suite à des manipulations malencontreuses dans la feuille.)
Elle ne réattribue pas un identifiant déjà créé, même s'il a été effacé dans la feuille.
Elle avertit de l'épuisement du stock d'identifiants.

Attention à la place de la ligne

Code:

[COLOR="DarkSlateGray"][B]Const nMax& = 0 [COLOR="Red"]'Cette ligne doit être TOUJOURS la troisième ligne du module.[/COLOR][/B][/COLOR]

S'il est nécessaire de la placer ailleurs, il faudra modifier cette ligne :

Code:

[COLOR="DarkSlateGray"][B]ThisWorkbook.VBProject.VBComponents(Me.CodeName).CodeModule.ReplaceLine [COLOR="Red"]3[/COLOR], "Const nMax = " & n & "'Cette ligne doit être TOUJOURS la [COLOR="Red"]troisième[/COLOR] ligne du module."[/B][/COLOR]

Remarque : Ici la constante nMax est initialisée à 0 pour commencer la liste des identifiants par U0001. Pour commencer au rang n, initialisez la constante à n-1.

ROGER2327
#4147

Mercredi 11 Absolu 138 (Sainte Purée, sportswoman, SQ)
2ème Sanculottide An CCXVIII
2010-W37-6T14:54:04Z

Pouetpouet72 · 18 Septembre 2010

Re : Creer un ID unique via macro

Re,

Effectivement la on atteint le summum...😀

Par contre, j'obtient une erreur dans ton fichier comme quoi le code VBA n'est pas fiable (je suis en ecel 2010 est ce la raison?)
Si tu veux jeter un oeil, je te met mon fichier en pj.

Dans ce fichier, il s'agit de la colone M qui recupere l'ID. que faire egalement si je decide de la deplacer en A ? je pense que cela ne fonctionnera plus sauf si je change un parametre mais lequel ? ... de toute facon cela m'obligera egalement a reecrire toutes mes macro

En tout cas un enorme merci pour ta contribution c'est super sympa 😛

JCGL · 18 Septembre 2010

Re : Creer un ID unique via macro

Bonjour à tous,

Il faut trouver et cocher dans les paramètres XL 2010 :

"Faire confiance au projet Visual Basic"

A+ à tous

Pouetpouet72 · 18 Septembre 2010

Re : Creer un ID unique via macro

Arf encore une bonne idée de microsft... Bilou et la "sécurité", une histoire d'amour....

Merci pour ton info JCGL.

Cependant cela devient embetant du coup car le fichier sera destiné à etre envoyé a des utilisateurs qui n'auront surement pas ton info precieuse, je vais donc devoir me contenter de la premiere solution.... qui est geniale ceci dit 😛

ROGER2327 · 19 Septembre 2010

Re : Creer un ID unique via macro

Re...

Pouetpouet72 à dit:
(...) j'obtient une erreur dans ton fichier comme quoi le code VBA n'est pas fiable (je suis en ecel 2010 est ce la raison?) (...)

JCGL fournit le remède...
J'ajoute que ce genre de remarque (sur la fiabilité*) me fait doucement rigoler quand il vient de gugusses qui croient, et essaient, depuis des décennies, de faire croire au monde entier, qu'il y eut un 29 février 1900, qui sont incapables de décompter exactement le nombre de jours écoulés depuis le premier janvier 1900, qui prétendent que la réunion de l'ensemble vide et d'un ensemble non vide n'existe pas (essayez un jour d'écrire

Code:

[COLOR="DarkSlateGray"][B]Set x = Union(Range("A1:A2"), Intersect(Range("A1"), Range("B1")))[/B][/COLOR]

dans une procédure), et autres fariboles dont le classeur joint donne un exemple.
À vous de voir à qui vous faites confiance en matière de fiabilité.

Pouetpouet72 à dit:
(...)
Si tu veux jeter un oeil, je te met mon fichier en pj.
(...)

Ne disposant que d'Excel2003, je ne peux pas tester votre fichier.

Pouetpouet72 à dit:
(...)
Dans ce fichier, il s'agit de la colone M qui recupere l'ID. que faire egalement si je decide de la deplacer en A ? je pense que cela ne fonctionnera plus sauf si je change un parametre mais lequel ? ... de toute facon cela m'obligera egalement a reecrire toutes mes macro
(...)

J'ai cru être clair en écrivant :

Code:

[COLOR="DarkSlateGray"][B]   Nom = 1 [COLOR="YellowGreen"]'rang de la colonne des Noms[/COLOR]
   IDn = 2 [COLOR="YellowGreen"]'rang de la colonne des Identifiants[/COLOR][/B][/COLOR]

pour l'exemple fourni où les noms sont dans la colonne A (ou 1) et les identifiants dans la colonne B (ou 2).

Je pensais qu'on pourrait en déduire que, si la colonne des identifiants devait être la colonne M, il faudrait écrire :

Code:

[COLOR="DarkSlateGray"][B]   Nom = 1 [COLOR="YellowGreen"]'rang de la colonne des Noms[/COLOR]
   IDn = 13 [COLOR="YellowGreen"]'rang de la colonne des Identifiants[/COLOR][/B][/COLOR]

J'avais tort...

Bonne nuit !

ROGER2327
#4148

Mercredi 11 Absolu 138 (Sainte Purée, sportswoman, SQ)
2ème Sanculottide An CCXVIII
2010-W37-6T22:33:53Z

____________
* fiablité : sérieux, crédibilité, solidité, vraisemblance...

ROGER2327 · 20 Septembre 2010

Re : Creer un ID unique via macro

Suite...

On peut rendre la solution proposée moins sensible à la surveillance en modifiant la procédure et le classeur.

En effet, vous aurez remarqué que la procédure modifie le contenu du module de la feuille qui la porte. La ligne

Code:

[COLOR="DarkSlateGray"][B]      ThisWorkbook.VBProject.VBComponents(Me.CodeName).CodeModule.ReplaceLine 3, "Const nMax = " & n & "'Cette ligne doit être TOUJOURS la troisième ligne du module."[/B][/COLOR]

réécrit la ligne 3 du module, pour y conserver le rang le plus élevé des identifiants créés.
Or Guillaume Porte n'aime pas qu'une procédure modifie une procédure : d'où le rappel à l'ordre si l'option "Faire confiance au projet Visual Basic" n'est pas choisie.
Il suffit donc de modifier la procédure pour qu'elle ne modifie pas le code.

On peut, par exemple ajouter une feuille cachée dans laquelle on conservera le rang le plus élevé des identifiants créés dans la cellule A1.

Le classeur joint donne un exemple d'un tel code :

Code:

[COLOR="DarkSlateGray"][B]Private Sub Worksheet_Change(ByVal Target As Range)
Dim Nom%, IDn%
Dim n&, oPlg As Object, oCel As Range, oColl As New Collection
   Nom = 1 [COLOR="YellowGreen"]'rang de la colonne des Noms[/COLOR]
   IDn = 2 [COLOR="YellowGreen"]'rang de la colonne des Identifiants[/COLOR]
   [U]n = FU9ONQ9HIFHSKNUQ.[A1].Value[/U]
   Set oPlg = Intersect(Target, Columns(Nom).Resize(Rows.Count - 1, 1).Offset(1, 0))
   If Not oPlg Is Nothing Then
      With Range(Cells(1, IDn), Cells(Rows.Count, IDn).End(xlUp))
         For Each oCel In .Cells
            If oCel.Value Like "U####" Then
               On Error Resume Next
               oColl.Add Item:=oCel.Value, Key:=CStr(oCel.Value)
               If Err.Number <> 0 Then GoTo E
               On Error GoTo 0
               n = WorksheetFunction.Max(n, Val(Right$(oCel.Value, 4)))
            End If
         Next oCel
      End With
      Application.Calculation = xlCalculationManual
      For Each oCel In oPlg.Cells
         If n = 9999 Then MsgBox "Tous les identifiants ont été attribués." & vbLf & "Désolé...": Exit For
         If IsEmpty(oCel.Offset(0, IDn - Nom)) And Not IsEmpty(oCel) Then
            n = n + 1
            Application.EnableEvents = False
            oCel.Offset(0, IDn - Nom).Value = "U" & Format(n, "0000")
            Application.EnableEvents = True
         End If
      Next oCel
      [U]FU9ONQ9HIFHSKNUQ.[A1].Value = n[/U]
S:    Application.Calculation = xlCalculationAutomatic
   End If
   Set oPlg = Nothing
Exit Sub
E: MsgBox "L'identifiant " & oCel.Value & " n'est pas unique." & vbLf & "Vérifier la colonne " & IDn & "."
   Err.Number = 0
   Resume S
End Sub[/B][/COLOR]

La modification ne concerne que les deux lignes soulignées et la suppression de la ligne de déclaration

Code:

[COLOR="DarkSlateGray"][B]Const nMax& = 0 [COLOR="YellowGreen"]'Cette ligne doit être TOUJOURS la troisième ligne du module.[/COLOR][/B][/COLOR]

Le classeur contient une feuille cachée (Onglet FU9O-NQ9H-IFHS-KNUQ, nom de code FU9ONQ9HIFHSKNUQ) dont le nom est volontairement "bizarre" pour éviter le risque de conflit avec le nom des autres onglets : il est peu probable qu'on souhaite nommer une feuille FU9ONQ9HIFHSKNUQ.

Pour que l'administrateur puisse accéder à cette feuille cachée, voici un code possible :

Code:

[COLOR="DarkSlateGray"][B]Private Sub CHOISIR_ID_MIN()
   With FU9ONQ9HIFHSKNUQ: .Visible = IIf(.Visible = xlSheetVisible, xlSheetVeryHidden, xlSheetVisible): End With
End Sub[/B][/COLOR]

Séquence de touches pour l'exécuter (Excel2003) :

Alt+F8 feuil1.choisir_id_min

et valider.

Cette solution ne devrait pas être refusée par votre Excel2010 (mais je n'ai pu le vérifier faute de disposer d'un telle version). Merci de m'informer de ce qu'il en est réellement...

ROGER2327
#4153

Vendredi 13 Absolu 138 (Saint Cantarel, l'illuminateur, SQ)
4ème Sanculottide An CCXVIII
2010-W38-1T10:45:21Z

Pouetpouet72 · 20 Septembre 2010

Re : Creer un ID unique via macro

Bonjour ROGER2327,

Effectivement cela fonctionne a merveille.

J'ai egalement fais le test de supprimer un ligne entiere (avc pour ID 24 par ex), il me genere un nouveau ID 25 pour la prochaine ce qui est plus que top !!!

Par conte si l'utilisateur supprime toutes les infos de la ligne (cellule par cellule ou suppression de la selection des cellules rempli SAUF l'id en lui meme (ce qui peut arriver car la colonne id etant caché), alors cette id ne disparait pas et reste le meme pour la nouvelle saisie ce qui entraine des erreur apres mais bon en meme temps cela a de tres faible propabilité d'arriver.

C'est deja plus que parfait pour moi, un grand merci pour ton travail (et dsl pour le post d'avant ce que je voulais dire c'etait plutot que d'utiliser un chiffre de colonne pour les rang, utiliser la valeur presente en 1 (ex : "Nom") comme ca la colonne "Nom" peut se trouver n'importe ou cela n'aura pas d'incidence, mais j'ai laisser tomber cette idée, cela me convenant tres bien)

A+ 😎

ROGER2327 · 20 Septembre 2010

Re : Creer un ID unique via macro

Re...

Pouetpouet72 à dit:
(...)
C'est deja plus que parfait pour moi, un grand merci pour ton travail (et dsl pour le post d'avant ce que je voulais dire c'etait plutot que d'utiliser un chiffre de colonne pour les rang, utiliser la valeur presente en 1 (ex : "Nom") comme ca la colonne "Nom" peut se trouver n'importe ou cela n'aura pas d'incidence, mais j'ai laisser tomber cette idée, cela me convenant tres bien)
(...)

Aucun problème avec ça. Je dépose une proposition d'ici peu.

ROGER2327
#4154

Vendredi 13 Absolu 138 (Saint Cantarel, l'illuminateur, SQ)
4ème Sanculottide An CCXVIII
2010-W38-1T14:38:22Z

ROGER2327 · 20 Septembre 2010

Re : Creer un ID unique via macro

Suite...

En remplaçant le code de la feuille Feuil1 du précédent classeur par celui-ci, vous devriez obtenir ce que vous souhaitez.

Code:

[COLOR="DarkSlateGray"][B]Option Explicit
[U]Option Compare Binary[/U]

Private Sub CHOISIR_ID_MIN()
   With FU9ONQ9HIFHSKNUQ: .Visible = IIf(.Visible = xlSheetVisible, xlSheetVeryHidden, xlSheetVisible): End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Champ_Nom$, Champ_IDn$, Nom%, IDn%, oCl&
Dim n&, oPlg As Object, oCel As Range, oColl As New Collection
'
   Champ_Nom = "NOM" [COLOR="YellowGreen"]'intitulé de la colonne des Noms[/COLOR]
   Champ_IDn = "ID" [COLOR="YellowGreen"]'intitulé de la colonne des Identifiants[/COLOR]
'
   oCl = Cells(1, Columns.Count).End(xlToLeft).Column
   With Range(Cells(1, 1), Cells(1, oCl))
      For Nom = 1 To oCl
         If .Cells(1, Nom) Like Champ_Nom Then Exit For
      Next
      For IDn = 1 To oCl
         If .Cells(1, IDn) Like Champ_IDn Then Exit For
      Next
   End With
   If Nom > oCl Or IDn > oCl Then GoTo W_C2
   n = FU9ONQ9HIFHSKNUQ.[A1].Value
   Set oPlg = Intersect(Target, Columns(Nom).Resize(Rows.Count - 1, 1).Offset(1, 0))
   If Not oPlg Is Nothing Then
      With Range(Cells(1, IDn), Cells(Rows.Count, IDn).End(xlUp))
         For Each oCel In .Cells
            If oCel.Value Like "U####" Then
               On Error Resume Next
               oColl.Add Item:=oCel.Value, Key:=CStr(oCel.Value)
               If Err.Number <> 0 Then GoTo E
               On Error GoTo 0
               n = WorksheetFunction.Max(n, Val(Right$(oCel.Value, 4)))
            End If
         Next oCel
      End With
      Application.Calculation = xlCalculationManual
      For Each oCel In oPlg.Cells
         If n = 9999 Then MsgBox "Tous les identifiants ont été attribués." & vbLf & "Désolé...": Exit For
         If IsEmpty(oCel.Offset(0, IDn - Nom)) And Not IsEmpty(oCel) Then
            n = n + 1
            Application.EnableEvents = False
            oCel.Offset(0, IDn - Nom).Value = "U" & Format(n, "0000")
            Application.EnableEvents = True
         End If
      Next oCel
      FU9ONQ9HIFHSKNUQ.[A1].Value = n
S:    Application.Calculation = xlCalculationAutomatic
   End If
   Set oPlg = Nothing
' Suite de la procédure Worksheet_Change
W_C2:
Exit Sub
E: MsgBox "L'identifiant " & oCel.Value & " n'est pas unique." & vbLf & "Vérifier la colonne " & IDn & "."
   Err.Number = 0
   Resume S
End Sub[/B][/COLOR]

ROGER2327
#4155

Vendredi 13 Absolu 138 (Saint Cantarel, l'illuminateur, SQ)
4ème Sanculottide An CCXVIII
2010-W38-1T15:26:31Z

Creer un ID unique via macro

Pouetpouet72

Guest

Habitude

XLDnaute Accro

JNP

XLDnaute Barbatruc

Pièces jointes

ROGER2327

XLDnaute Barbatruc

JNP

XLDnaute Barbatruc

Pouetpouet72

Guest

ROGER2327

XLDnaute Barbatruc

Pièces jointes

Pouetpouet72

Guest

Pièces jointes

JCGL

XLDnaute Barbatruc

Pouetpouet72

Guest

ROGER2327

XLDnaute Barbatruc

Pièces jointes

ROGER2327

XLDnaute Barbatruc

Pièces jointes

Pouetpouet72

Guest

ROGER2327

XLDnaute Barbatruc

ROGER2327

XLDnaute Barbatruc

Discussions similaires

Creer un ID unique via macro

Pouetpouet72

Guest

XLDnaute Accro

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

Pouetpouet72

Guest

XLDnaute Barbatruc

Pièces jointes

Pouetpouet72

Guest

Pièces jointes

XLDnaute Barbatruc

Pouetpouet72

Guest

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

Pouetpouet72

Guest

XLDnaute Barbatruc

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency