Discussion :

[ouskel'n'or]

Voir ici la réponse corrigée suite aux diverses interventions ou simplifications.

[dadavyvy]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Option Compare Binary

et pas en

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Option Compare Text

[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 )
Tu peux tester pour moi ? Merci

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

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

            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

[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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

Right(tb2(n), 1)

car tb2(n) = "". Mais là, c'est vraiment pour chipoter...

[SilkyRoad]

bonsoir à vous

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

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


bonne sorée
michel

[ouskel'n'or]

A force d'être tordu, le code fourni par petits bout ne fonctionnait plus
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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[dadavyvy]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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...

[ouskel'n'or]

Tu as raison. J'avais d'abord mis

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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