Nom + 1ere lettre prénom si doublon
Bonjour à tous,
Malgré quelques, recherche je n'arrive pas à trouver une solution à mon problème même si ce dernier parait simple :
J'ai une liste de nom de personne participant à une formation or certain peuvent avoir le même nom. Afin de les différencier je souhaite ajouter un point ainsi que la première lettre du prénom dans la case nom.
En gros si j'ai :
A1 =Dupont B1=Fabien
A1 =Dupont B1= George
Je souhaite obtenir :
A1 =Dupont.F B1=Fabien
A1 =Dupont.G B1= George
Merci d'avance pour votre aide
Bonjour Arno51,
Imagine que ton organisme de formation reçoive les membres de 2 familles ayant le même nom de famille : c'est très possible avec un patronyme très répandu comme par exemple « Dupont » ; dans ce cas, si tu as un « Dupont Jean » d'une famille et un autre « Dupont Jean » d'une autre famille, ta solution ne permettra toujours pas de les distinguer, même si tu ajoutes au nom de famille un point suivi du prénom entier !
Je te propose cette solution : attribuer un code à chaque participant de la formation ; reste à choisir le bon code ; ça pourrait être simplement 1 ; 2 ; 3 ... mais tu peux aussi, par exemple, mettre 1802.01 pour le 1er participant qui s'inscrit en février 2018 ; 1802.02 pour le 2ème participant qui s'inscrit en février 2018 ; 1802.03 pour le 3ème participant qui s'inscrit en février 2018 ... ainsi, ce code distinguera chaque participant, même s'il a le même nom et prénom qu'un autre, et en plus, juste à lire ce code, tu sauras quand il s'était inscrit : en tel mois de telle année ; mais place d'abord l'année, en prévision d'un tri sur le code.
Tu peux affiner le code si ton organisme de formation dispense plusieurs formations différentes ; exemple : SCT = secrétariat ; CPT = comptabilité ; INF = Informatique ; code = 1802.CPT.05 pour le 5ème participant à la formation de comptabilité de février 2018 (c'est par exemple ton 1er Dupont Jean) ; code = 1802.INF.12 pour le 12ème participant à la formation d'informatique de février 2018 (c'est par exemple ton 2ème Dupont Jean). NB : note que le 0 de 05 est pour conserver l'ordre de tri par rapport à 12 ; donc s'il y a plus de 99 participants, ajouter un 0 : 1802.CPT.005 et 1802.INF.012 ; ordre conservé par rapport à 1802.INF.132.
Il va de soi que cette codification marchera même pour les membres d'une même famille.
Cordialement,
dhany
Merci à tous pour ces infos,
Effectivement les deux Noms avec même prénom peux poser soucis. Je vais tester tout ça et je vous tiens au courant.
est il possible de comparer les lettres une à une d'une cellule?
Car j'ai pensé à quelque chose du genre :
a=cells(1,1).value
là je tape le code pour récupérer la première lettre différente de la cellule prénom
que j'écris dans une autre cellule différente genre cells(1,5)
et ensuite
b = cells(1,5).value
cells(1,1).value = a & "." & b
Je ne sais pas si cela fonctionne. N'étant pas expert je vais tenter mais si certain sont plus rapide que moi je veux bien un petit coup de main.
Merci
Regarde dans l'aide Excel ces 3 fonctions :
=GAUCHE() permet de récupérer la partie gauche d'une chaîne de caractère ; en VBA : Left$()
=DROITE() permet de récupérer la partie droite d'une chaîne de caractère ; en VBA : Right$()
=STXT() permet de récupérer une partie "interne" d'une chaîne de caractère (STXT = sous-texte) ; c'est équivalent au Mid$() de VBA
Pour comparer les lettres une à une, tu devras en prendre une, avec la fonction STXT().
Si tu testes une cellule qui contient un texte (= chaîne de caractères), les fonctions textes qui utiliseront cette cellule marcheront aussi bien que sur des chaîne de caractères littérales (= texte entre guillemets).
Il y a d'autres fonctions texte bien utiles (voir l'aide Excel sur les fonctions texte).
dhany
Merci,
voici le résultat de mon test, il est un peu long j'avoue mais il a l'air de fonctionner.
Je n'ai pas fait la vérification des chaînes de Caractère car trop compliqué pour moi donc la solution c'est soit une lettre, soit trois soit
un message indiquant deux prénom très similaire avec leur adresse de cellule.
SI les experts on un avis pour alléger le code ou pour faire la comparaison des chaînes de Caractère de la cellule prénom ce serait un GRAND PLUS.
Quand pensez-vous?
Si vous souhaitez que je mette un fichier excel je peux le faire mais je dois le créer car je ne peux donner mon fichier original avec les noms des personnes réelles. Merci à vous encore une fois
Sub test3()
Dim Un As Collection
Set Un = New Collection
On Error Resume Next
For m = 5 To 40 ' plage où se trouve mes cellules (généralement 40 remplacé par derlig = ... car tableau variable)
If Cells(m, 3) <> "" Then 'Pour ne pas prendre en compte les cellules vides
Un.Add Cells(m, 3), CStr(Cells(m, 3)) 'Ajoute le contenu de la cellule dans la collection
'Si la procédure renvoie une erreur, cela signifie
'que l'élément existe déjà dans la collection et
'donc qu'il s'agit d'un doublon
If Err <> 0 Then Cells(m, 3).Offset(0, -1).Value = Cells(m, 3).Value ' inscrit le doublon dans une colonne vide
Err.Clear 'Efface toutes les valeurs de l'objet Err.
End If
Next m
Set Un = Nothing
With Worksheets(1).Range("C:C")
For m = 5 To 40
If Cells(m, 2) <> "" Then 'valeur où se trouve le nom du doublon
valeur = Application.WorksheetFunction.CountIf(Columns("C:C"), Cells(m, 2).Value) 'détermine le nbr de doublon
For n = 1 To valeur 'execute pour tous les doublons
Set x = .Find(Cells(m, 2).Value, lookat:=xlWhole) 'cherche valeur exacte du doublon
a = x.Value ' sauvegarde le nom de famille
b = Left(x.Offset(0, 1), 1) ' prend la 1 ère lettre du Prénom
x.Value = a & "." & b ' Modifie le nom de famille
Set x = .FindNext(x) ' cherche le doublon suivant
Next n
End If
Next m
End With
Set Un = New Collection
For m = 5 To 40 ' je réitère pour identifier le Nom+ initiale identique s'il en existe
'commentaire uniquement sur les modifications éffectuées
If Cells(m, 3) <> "" Then
Un.Add Cells(m, 3), CStr(Cells(m, 3))
If Err <> 0 Then
Cells(m, 3).Offset(0, -2).Value = Cells(m, 3).Value 'inscrit dans une colonne vide (autre que la 1ère)
Err.Clear
End If
End If
Next m
Set Un = Nothing
With Worksheets(1).Range("C:C")
For m = 1 To 50
If Cells(m, 1) <> "" Then
valeur = Application.WorksheetFunction.CountIf(Columns("C:C"), Cells(m, 1).Value)
For n = 1 To valeur
Set x = .Find(Cells(m, 1).Value, lookat:=xlWhole)
a = x.Value
b = Right(x.Offset(0, 1), Len(x.Offset(0, 1)) - 1) ' je prend tout le Prénom sauf la 1ère lettre car déjà dans a
'peux être modifié par Mid(x.Offset(0, 1), 2, 2) pour n'obtenir
' que les 2ème et 3 ème lettre du prénom
x.Value = a & b
Set x = .FindNext(x)
Next n
End If
Next m
End With
Set Un = New Collection
For m = 5 To 40 'une dernière fois si Prénom identique
If Cells(m, 3) <> "" Then
Un.Add Cells(m, 3), CStr(Cells(m, 3))
If Err <> 0 Then ' msg indiquant le Doublon et leurs positions
MsgBox ("Les Noms et 1ère Lettre du Prénom sont identique pour :" & vbNewLine _
& Cells(m, 3).Value & vbNewLine & Cells(m, 3).Address & " et " & Cells(m, 3).Offset(-1, 0).Address)
Err.Clear
End If
End If
Next m
Range("A:B").Clear 'supprime les valeurs de recherche précédente
Set Un = Nothing
End Sub