[VBA-E] Séparer Nom Prénom placés dans une cellule unique

Version imprimable

05/04/2007, 23h47
ouskel'n'or

[VBA-E] Séparer Nom Prénom placés dans une cellule unique

Voir ici la réponse corrigée suite aux diverses interventions ou simplifications.
07/04/2007, 13h01
dadavyvy

A noter que l'astuce dans l'Edit fonctionne seulement si on est en (par défaut)

Code:

Option Compare Binary

et pas en

Code:

Option Compare Text
07/04/2007, 19h19
ouskel'n'or

Hello dadavyvy,
Alors pour te contrarier, j'ai pensé à autre chose : Ne tester que le dernier caractère des mots. Plus de boucle.
Je n'utilise pas compare, j'utilise Lcase. Tu es sûr que l'option binary est nécessaire ? (Je n'ai pas Excel, pas vba, chuis dans le midi au soleil et je faisais juste un tour sur le forum, je ne peux pas vérifier mais ce que tu me dis m'étonne 8O )
Tu peux tester pour moi ? Merci

Pour le test du dernier cararactère du mot, on remplace tout ça

Citation:

For i = 2 To Len(tb2(n))
......LeCar = Asc(Mid(tb2(n), i, 1))
......pr = LeCar > 96 And LeCar < 123 Or LeCar > 223 'c'est un prénom
......If pr Then Exit For
Next

par

Code:

LeCar = Asc(lcase(Right(tb2(n), 1))) = Asc(Right(tb2(n), 1))

Je corrigerai le code quand j'aurai testé... à moins que tu le fasses pour moi ;)
07/04/2007, 20h26
dadavyvy
Pour l' 'Option Compare Binary' est l'option par défaut d'un module VBA - Excel (dans Access on également 'Option Compare Database' qui n'existe pas dans Excel). Par contre, si jamais on venait à forcer cette option en 'Option Compare Text' les comparaisons se ferait sans distinction des majuscules :
Code:

1 2 3 4 Option Compare Text Sub test() MsgBox "a" = "A" ' retourne Vrai End Sub
C'est le même principe lorsque l'on veut utiliser la fonction Replace (ou Instr, ou encore Split) et son argument Compare...

A part ca, Ouskel'n'or, magnifique ton dernier code, il suffit de vérifier le code Ascii du dernier caractere. Comme quoi, on peut toujours ameliorer un code jusqu'a le rendre optimum.

Encore une derniere remarque, juste pour faire bosser Ouskel'n'or pendant ses vacances au soleil :
Si tu as 2 espaces consécutifs (par le hasard d'une eventuelle erreur de l'utilisateur), le code va planter là :

Code:

Right(tb2(n), 1)

car tb2(n) = "". Mais là, c'est vraiment pour chipoter...
07/04/2007, 20h44
SilkyRoad

bonsoir à vous

C'est aussi possible sans macro ... ;o)

http://www.developpez.net/forums/sho...d.php?t=306720

bonne sorée
michel

A force d'être tordu, le code fourni par petits bout ne fonctionnait plus :cry:
Je reprends donc mon code pour tenir compte des observations de dadavouivoui et les simplifications apportés au cours de longues nuits de cogitation Pièce jointe 11867

Le but : Séparer le nom du prénom réunis dans une colonne unique pour les répartir dans deux colonnes

......Sur une idée de beegees -> Tester les minuscules pour détecter le prénom
......Une méthode de bbil -> Créer un tableau des mots dans nom+prénom
......L'extrapolation d'une idée de dadavyvy -> Tester la casse des caractères,
......et sa participation active dans l'examen des différents cas de figures
......à prendre en compte -> Doubles espaces, option binary...

Restait plus qu'à...

Ce code ne fonctionne que si les noms sont en majuscules, les prénoms n'ont que le premier caractère en majuscule, le reste en minuscules.

Pris en compte :
- Les noms ou les prénoms composés
- Les noms ou les prénoms accentués ou non
- Les noms comportant des apostrophes
- Les noms précédant le prénom
- Les noms précédés du prénom
- Les noms ou prénoms séparés par plusieurs espaces

Les données sont insérées dans la feuille contenant les NomPrénoms. Pour cela une colonne est insérée pour les prénoms à droite de la colonne des noms.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 Option Explicit Option Compare Binary 'Seulement utile si vous avez 'Option Compare Text... '... quelque part dans le code précédent cette macro Sub Lecture() Dim NoCol As Integer Dim Ws As Worksheet Dim Cel As Range Set Ws = Worksheets("Feuil1") 'Feuille analysée NoCol = 5 'Colonne lue 'Insertion à droite de la colonne "Nom" d'une colonne "Prénom" Ws.Columns(NoCol + 1).Insert Shift:=xlToRight Ws.Cells(1, NoCol + 1) = "Prénom" 'entête de colonne 'Parcours de la colonne à partir de la seconde ligne For Each Cel In Ws.Range(Ws.Cells(2, NoCol), _ Ws.Cells(Ws.Range(Ws.Cells(1, NoCol).Address). _ SpecialCells(xlCellTypeLastCell).Row, NoCol)) If Not Cel Is Nothing Then Call Ecriture(Ws, NoCol, Cel.Value, Cel.Row) Else Exit For 'Rien dans la cellule, on quitte End If Next End Sub Sub Ecriture(Ws, NoCol, NomPrenom, WsRow) Dim st As String, tb() As String Dim n As Integer Dim LeNom As String, Prenom As String, LeCar As String Dim pr As Boolean, WsRange As Range st = NomPrenom tb = Split(st, " ") For n = 0 To UBound(tb) If tb(n) <> "" Then ''Pour dadavyvy qui mets plein d'espaces entre les mots ^^^ 'On vérifie que le dernier caractère du mot est une minuscule If Asc(Right(LCase(tb(n)), 1)) = Asc(Right(tb(n), 1)) Then Prenom = Prenom & " " & tb(n) Else 'Pas de minuscule, c'est le nom LeNom = LeNom & " " & tb(n) End If End If Next Set WsRange = Ws.Cells(WsRow, NoCol) WsRange.Value = Trim(LeNom) WsRange.Offset(0, 1).Value = Trim(Prenom) End Sub
Ouf !

NB - Après moulte tests, il n'en demeure pas moins un pb : Les noms qui se terminent par une apostrophe sont considérés comme des prénoms.
Ainsi, "JÉPERDUL' Truc" met tout dans la colonne prénom... Faudra faire attention :mouarf:

Pour éviter le problème de l'apostrophe à la fin d'un nom, il faut revenir à la vérification du code Ascii et l'utilisateur définira alors les codes qu'il considère comme des minuscules. Ne pas oublier alors les codes 154 (š), 156 (œ) et 158 (ž), etc...

Pour en revenir au commentaire qui me concerne, je changerais la boucle en (sinon on a toujours un plantage) :
Code:

1 2 3 4 5 6 7 8 9 For n = 0 To UBound(tb) If tb(n) <> "" Then If Asc(Right(LCase(tb(n)), 1)) = Asc(Right(tb(n), 1)) Then Prenom = Prenom & " " & tb(n) Else LeNom = LeNom & " " & tb(n) End If End If Next
Et pour ma défense, je dirais que ce n'est pas moi qui m'amuse à mettre des espaces à tout va... :-Þ Certaines personnes doivent trouver cela amusant surtout les espaces à la fin d'un mot. Et après, vive les comparaisons, les recherchev, etc... C'est pour ça que je mets du Trim un peu partout...

Tu as raison. J'avais d'abord mis
Code:

1 2 3 4 5 6 For n = 0 To UBound(tb) pr = tb(n) <> "" If pr and Asc(Right(LCase(tb(n)), 1)) = Asc(Right(tb(n), 1)) Then '... elseif pr then '...
et au dernier moment, j'ai "simplifié"
Je corrige mon code, je ne vais pas en rajouter.
Merci de cette lecture attentive