Attribuer un code unique automatiquement

Bonjour,

Je reçois des pièces régulièrement et je rentre dans un tableau excel la date de réception ainsi que leur couleur. J'aimerai créer un code unique pour chaque pièce. Il y a trois couleurs bleu, qui sera représentée par B dans le code, rouge par R et vert par V. La première pièce bleue reçue sera donc B001, la cinquième pièce verte reçue sera V005 et ainsi de suite. Je souhaite que à chaque fois que je rentre une pièce, une macro s'active pour créer ce code et le figer pour qu'il soit fixe et unique pour chaque pièce.

J'ai mis mon tableau en PJ, en espérant que quelqu'un puisse m'aider.

Je vous remercie par avance

40code-couleur.zip (6.51 Ko)

Bonjour. bienvenue sur le Forum

Code Feuil1

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("C:C")) Is Nothing Then
Dim Nbr As String
Nbr = Application.CountIf(Range("C2:" & Target.Address), Target.Value)
Target.Offset(0, 1) = Left(Target, 1) & Format(Nbr, "000")
End If

End Sub

Cordialement

44code-couleur.zip (10.10 Ko)

Bonjour et merci pour ton aide,

j'ai entré ça dans mon module mais j'ai un message d'erreur qui s'affiche disant

End Sub attendu.

Je ne comprend pas, j'ai bien mis le End Sub et je ne vois pas d'où ça vient

Sub code_couleur()

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Application.Intersect(Target, Range("C:C")) Is Nothing Then

Dim Nbr As String

Nbr = Application.CountIf(Range("C2:" & Target.Address), Target.Value)

Target.Offset(0, 1) = Left(Target, 1) & Format(Nbr, "000")

End If

End Sub

Bonjour

Avec la majuscule

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("C:C")) Is Nothing Then
Dim Nbr As String
Nbr = Application.CountIf(Range("C2:" & Target.Address), Target.Value)
Target.Offset(0, 1) = UCase(Left(Target, 1)) & Format(Nbr, "000")
End If
End Sub

Cordialement

65code-couleur.zip (10.27 Ko)

Je ne vois pas de quelle majuscule tu veux parler, j'ai essayé plusieurs trucs mais j'ai toujours le même message d'erreur

Bonjour

Je t'ai envoyé le fichier

As-tu testé avec?

Par ailleurs, j'ai indiqué sur mon premier message Code de Feuille et non Code dans un Module

Cordialement

Rechercher des sujets similaires à "attribuer code unique automatiquement"