Nettoyage de noms complets

Bonjour à tous,

Mon sujet est le suivant :

J'ai un fichier de noms complets de plusieurs milliers de personnes, et je désirerais en faire des listes de diffusion. A ce titre j'ai besoin de mapper des NOMS puis des Prénoms.

La difficulté c'est quand vous avez un format MACHIN-TRUC DE BIDULE Huan Tong José-Louis Mehmet et que vous voulez remplir des cases "Nom" = [MACHIN-TRUC DE BIDULE], "Prénom" = [Huan Tong José-Louis Mehmet]

Dans un premier temps j'ai voulu repérer les majuscules dans une chaine de caractères, j'ai perdu une partie de ma matinée puis j'ai changé mon fusil d'épaule et j'ai voulu tronquer la chaîne de caractères initiales en fonction des espaces avec un SPLIT, pour les concaténer par lots en fonction de la casse avec une logique genre if chaine=uCase(chaine) donc nom en majuscule donc à mettre dans une liste à concaténer sinon liste prénom.

J'ai un résultat sur ma première idée avec ceci :

 With Sheets(1)

        derniere_ligne = .Cells(.Rows.Count, 1).End(xlUp).Row

        While ligne <= derniere_ligne

        chaine = Cells(ligne, 1)
        texte_decomp() = Split(chaine)

            For i = LBound(texte_decomp) To UBound(texte_decomp)

                Cells(ligne, colonne + i).Value = texte_decomp(i)

            Next i

        ligne = ligne + 1

        Wend
    MsgBox ("Travail terminé")
    End With

Ça me met bien chaque blocs de caractères entre espace dans une colonne distincte

J'ai eu également un résultat avec UNE LIGNE pour ma deuxième idée avec :

For Each j In liste
                        If j = UCase(j) Then
                            nom = nom & " " & j

                        Else:
                            prenom = j
                        End If

                    Next j
        Cells(lig, 5).Value = nom
        Cells(lig, 6).Value = prenom

Mais dès que je mets ça dans la boucle ligne = ligne + 1 j'ai les noms qui se cumulent les uns aux autres (les prénoms c'est ok ) .

J'ai passé l'après-midi sur ce truc, mais je n'ai plus aucune idée et j'ai les yeux qui piquent.

Pouvez-vous m'aider.

Merci d'avance

Bonjour,

Je survole juste ton post mais si tu veux répartir sur plusieurs colonnes, il existe un outils dédié, onglet "Données" > zone "Outils de données" > bouton "Convertir", tu peux même utiliser l'enregistreur de macro pour voir le résultat en VBA !

Bonjour,

démarrer en ligne 2 si titres :

Sub decoup()
    Dim datas, result, lig As Long, nom As String, prenom As String, tmp, i As Long
    datas = [A1].Resize(Cells(Rows.Count, 1).End(xlUp).Row).Value
    ReDim result(1 To UBound(datas), 1 To 2)
    For lig = 1 To UBound(datas)
        nom = "": i = 0
        tmp = Split(datas(lig, 1), " ")
        Do While tmp(i) = UCase(tmp(i))
            nom = nom & " " & tmp(i)
            i = i + 1
        Loop
        result(lig, 1) = nom
        For i = i To UBound(tmp): result(lig, 2) = result(lig, 2) & " " & tmp(i): Next i
        For i = 1 To 2: result(lig, i) = Mid(result(lig, i), 2): Next i
    Next lig
    [B:C].ClearContents
    [B1:C1].Resize(UBound(result)) = result
End Sub

eric

Theze a écrit :

Bonjour,

Je survole juste ton post mais si tu veux répartir sur plusieurs colonnes, il existe un outils dédié, onglet "Données" > zone "Outils de données" > bouton "Convertir", tu peux même utiliser l'enregistreur de macro pour voir le résultat en VBA !

Bonjour Theze,

Merci d'avoir pris le temps de lire mon post et de me faire une réponse, notamment pour le rappel à l'enregistreur de macro dont je n'ai pas le reflexe .

Concernant la problématique qui était la mienne, puisque solutionnée par eriiic, la conversion de données permet bien la troncature de la chaine à nettoyer en blocs de texte en fonction d'un séparateur ad hoc. Pour autant, rassembler les "morceaux" au sein de catégories en fonction de leur casse était la difficulté puisque variable d'une chaine à l'autre. Tous les éléments "Nom" ne se trouvant pas systématiquement dans les mêmes colonnes.

C'est pour cela que je m'orientais vers la casse puisque le seul critère réellement discriminant est que les noms sont systématiquement en majuscules, enfin je l'espère (j'ai peur des particules du type Di BENEDETTO ou De LA MORY et des exotismes genre m'BALAK...), et que les prénoms comportent tous majoritairement des minuscules.

Merci encore,

En te souhaitant une bonne journée.

eriiic a écrit :

Bonjour,

démarrer en ligne 2 si titres :

Sub decoup()
    Dim datas, result, lig As Long, nom As String, prenom As String, tmp, i As Long
    datas = [A1].Resize(Cells(Rows.Count, 1).End(xlUp).Row).Value
    ReDim result(1 To UBound(datas), 1 To 2)
    For lig = 1 To UBound(datas)
        nom = "": i = 0
        tmp = Split(datas(lig, 1), " ")
        Do While tmp(i) = UCase(tmp(i))
            nom = nom & " " & tmp(i)
            i = i + 1
        Loop
        result(lig, 1) = nom
        For i = i To UBound(tmp): result(lig, 2) = result(lig, 2) & " " & tmp(i): Next i
        For i = 1 To 2: result(lig, i) = Mid(result(lig, i), 2): Next i
    Next lig
    [B:C].ClearContents
    [B1:C1].Resize(UBound(result)) = result
End Sub

eric

Bonjour eriiic,

Merci, merci, bravo et excellent ! Ma liste est entièrement nettoyée grâce à toi. J'y ai passé la journée d'hier et tu as tout résolu en un tournemain.

Comme tu as du t'en apercevoir, je débute et apprends sur le tas , ce qui fait que je vais me jeter sur ton code . Par contre c'est comme apprendre une langue sans dico , si tu le permets, j'ai quelques questions :

[A1].Resize(Cells(Rows.Count, 1).End(xlUp).Row).Value ?

Je pensais .Cells(.Rows.Count, 1).End(xlUp).Row immuable, que sont le [A1] et le .value ? Resize ?

Redim ?

J'ai très mal saisi l'utilisation des tableaux, j'ai lu en diagonale ce que je pouvais hier.J'ai vaguement cru qu'il fallait une instruction Array quelque part mais je pensais que puisque la boucle se faisait ligne par ligne sur la colonne 1 et que je voulais mon résultat ligne par ligne sur 2 colonnes, le tableau devait avoir une ligne et deux colonnes renouvelable à chaque itération. Visiblement ce n'est pas le cas, car tu lui donnes le nombre de lignes total de l'échantillon et 2 colonnes ( si je comprends bien le 1 To UBound(datas) et le 1 To 2.

nom = "": i = 0

Rhaâââ Késseucé ?

et le reste à l'avenant .....pourrait-on échanger sur ton code ?

Encore une fois merci et en te souhaitant un bonne journée

Bonjour,

Je pensais .Cells(.Rows.Count, 1).End(xlUp).Row immuable, que sont le [A1] et le .value ? Resize ?

- [A1], équivalent à Range("A1") est la 1ère cellule que je veux copier.

Ca pourrait aussi bien être [C2] tout en me basant toujours sur la hauteur de A.

• .value est la valeur de la cellule. Toujours préciser la propriété voulue et ne pas laisser vba choisir.
• Resize retaille un Range (plage)

-Redim ?

redimensionne la variable tableau.

Comme tu parlais de plusieurs milliers de lignes, il vaut mieux tout lire en une fois, travailler en mémoire avec des tableaux, et tout écrire en une fois.

La lecture et l'écriture de cellules est très très gourmandes. Tu peux passer ainsi de plusieurs longues minutes à une fraction de seconde.

nom = "": i = 0

: sépare 2 instructions sur une même ligne.

Il faut remettre le nom à vide et i à 0 avant d'attaquer la ligne suivante

j'ai peur des particules du type Di BENEDETTO ou De LA MORY et des exotismes genre m'BALAK..

dans ce cas boucle sur tmp en commençant par la fin :

For i = UBound(tmp) To 1 Step -1

Sub decoup()
    Dim datas, result, lig As Long, nom As String, prenom As String, tmp, i As Long
    datas = [A1].Resize(Cells(Rows.Count, 1).End(xlUp).Row).Value
    ReDim result(1 To UBound(datas), 1 To 2)
    For lig = 1 To UBound(datas)
        nom = "": i = 0
        tmp = Split(datas(lig, 1), " ")
        For i = UBound(tmp) To 1 Step -1
            If tmp(i) = UCase(tmp(i)) Then Exit For
        Next i
        For i = 0 To i: result(lig, 1) = result(lig, 1) & " " & tmp(i): Next i
        For i = i To UBound(tmp): result(lig, 2) = result(lig, 2) & " " & tmp(i): Next i
        For i = 1 To 2: result(lig, i) = Mid(result(lig, i), 2): Next i
    Next lig
    [B:C].ClearContents
    [B1:C1].Resize(UBound(result)) = result
End Sub

ça éliminera ces anomalies.

eric