Extraire données sur deux lignes meme cellule

Bonjour,

J'ai un fichier excel qui comprend les données suivantes:

1. Nom et prenom

2. Né(e) le ... à ....

3. adresse

4. Nationalité

Le probleme est que la cellule A contient les noms et prenoms, ainsi que date et lieu de naissance et ce sur deux lignes.

En fait je voudrais pouvoir extraire dans des cellules distinctes toutes les données:

1. nom

2. prenom

3. Date de naissance

4. Lieu de naissance

3. adresse

4. ville

5. CP

6. nationalité

En fait le probleme est que la colonne A qui contient nom, prenom date et lieu de naissance, lorsque je regarde format de ceulle dans alignement la case renvoy a ligne est cochée. Si je la decoche ma seconde ligne remonte mais se colle directement sur la premiere et le prenom est collé à "Né(e) le". Il n'y a pas d'espace entre les deux.

La colonne B qui conteint l'adresse a ussi le pb au niveau du CP et Ville qui sont collés.

Bref je ne sais pas si cela est possible d'extraire les données dans des cases distinctes ?

Je joins un fichier test de quelques lignes.

Merci.

Bdsa

26liste-client.xlsx (9.73 Ko)

Bonsoir,

A essayer...

Cordialement.

NB- Il ne faut pas faire de confusion entre ligne du tableur et texte sur plusieurs lignes dans la même cellule...

Bonsoir,

Vous êtes fantastique !!! Cela fonctionne tres bien... Je suis toujours admiratif de ce vous pouvez faire en si peu de temps. Merci encore.

Par-contre en essayant sur mon fichier, j'ai remarqué que dans certaines cellules A, il y avait une troisieme donnée, qui est le nom marital. Donc parfois on a:

1. Nom, prenom

2. Nom marital

3. Date et lieu de naissance

ou :

1. Nom, prenom

2. Date et lieu de naissance

Est-ce qu'il y a une possibilité de prendre cela en compte ?

Je joins un exemple avec cette troisieme donnée.

Merci encore.

Bdsa

22liste-client.xlsx (10.20 Ko)

J'ai considéré que tous les cas possibles étaient répertoriés dans ton modèle !

D'ailleurs difficile d'analyser les particularités d'un cas non présent !

Il a déjà fallu se contorsionner un peu pour ton "Chez machin" venant perturber l'organisation de l'adresse, qui m'a conduit à ajouter une colonne.

Là on ajoute une colonne ?

(J'espère que tu as bien recensé toutes les variantes, car je n'ai pas l'intention d'y revenir encore ensuite ! )

Bonjour,

Je suis désolé mais effectivement je serais dorénavant plus attentif à la structure complète du fichier. J ai repasser le fi hier au complet et je vois rien d autre.

Effectivement il faudrait créer une autre colonne 'nom marital'. Merci encore.

Bdsa

J'ai essayer d'adapter votre macro pour ajouter le nom marital mais je me perds dans toutes ces lignes de programmation . Ce sont des compétences que je suis loin de maîtriser....

Bonsoir,

J'étais dans des travaux de jardin, je vais m'en occuper... c'est toujours un peu fastidieux de modifier après coup, on loupe facilement des modif... La colonne Nom marital après Prénom je suppose ?

Merci encore de du temps que vous consacrez a ma demande. Oui idealement apres le prenom . Merci encore

Bdsa

C'est bon, sauf un point qui fait planter avant la fin... ton dernier item a une date de naissance en 1898 et Excel renâcle...

Je vais mettre une condition sur la date, voir si cela suffit...

Merci.

Voilà ! On devrait en être à la version définitive, sous réserve d'éléments ultérieurs... Le blocage sur la date venait du fait que en les récupérant dans la chaîne, je les convertissais en date, pour éviter la conversion automatique par VBA qui le fait alors en appliquant le format américain qui inverse jour et mois (quand les chiffres le permettent). VBA reconnaissant les dates avant 1900, pas de problème pour convertir en date 1898. Quand on tape une telle date dans Excel, il ne la reconnaît pas comme date et la prend comme texte, mais là la données lui était envoyée en type date, d'où refus d'Excel et erreur sur l'affectation, qui s'interrompait juste sur cette date, ce qui m'a permis de détecter la cause.

Si d'autres problèmes surviennent s'agissant de date, signale-le, j'ajouterai quelques tests supplémentaires.

Sub ReclasserDonnées()
    Dim Tbl(), Tmp, d, n%, i%, j%
    With Worksheets("Feuil1")
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        ReDim Tbl(n, 9)
        For i = 1 To n
            Tmp = Split(.Cells(i, 1), Chr(10))
            For j = 0 To 1
                Tbl(i, j) = Trim(Split(Tmp(0), "-")(j))
            Next j
            j = UBound(Tmp)
            If j > 1 Then Tbl(i, 2) = Trim(Replace(Tmp(1), "-", ""))
            d = Trim(Split(Tmp(j), "à")(0))
            If IsNumeric(Right(d, 4)) Then
                d = DateValue(Right(d, 10))
                If Year(d) < 1900 Then d = Format(d, "dd/mm/yyyy")
                Tbl(i, 3) = d
            End If
            Tbl(i, 4) = Trim(Split(Tmp(j), "à")(1))
            Tmp = Split(.Cells(i, 2))
            For j = UBound(Tmp) To 0 Step -1
                If Val(Tmp(j)) >= 1000 Then
                    If InStr(Tmp(j), Chr(10)) > 0 Then
                        d = Split(Tmp(j), Chr(10))(0)
                        Tmp(j) = Replace(Tmp(j), d, "@@")
                    Else
                        d = Tmp(j): Tmp(j) = "@@"
                    End If
                    Exit For
                End If
            Next j
            Tmp = Split(Join(Tmp), "@@")
            Tbl(i, 5) = Trim(Tmp(0))
            Tbl(i, 5) = Trim(Tmp(1))
            Tbl(i, 7) = Mid(d, 6, Len(d))
            Tbl(i, 8) = Format(Val(d), "00000")
            Tbl(i, 9) = .Cells(i, 3)
        Next i
    End With
    Tbl(0, 0) = "Nom": Tbl(0, 1) = "Prénom": Tbl(0, 2) = "Nom marital"
    Tbl(0, 3) = "Date de naissance": Tbl(0, 4) = "Lieu de naissance"
    Tbl(0, 5) = "Adresse": Tbl(0, 6) = "Complément": Tbl(0, 7) = "Ville"
    Tbl(0, 8) = "CP": Tbl(0, 9) = "Nationalité"
    With Worksheets("Feuil2").Range("A1")
        .CurrentRegion.Clear
        With .Resize(n + 1, 10)
            .Value = Tbl
            .WrapText = False
            With .Rows(1)
                .HorizontalAlignment = xlCenter
                .Font.Bold = True: .Font.Italic = True
            End With
            With .Columns(4)
                .NumberFormat = "dd/mm/yyyy"
                .HorizontalAlignment = xlRight
            End With
            .Columns(9).NumberFormat = "00000"
            .Columns.AutoFit
            .Rows.RowHeight = 15
            .Worksheet.Activate
        End With
    End With
End Sub

Pour ce qui est de la mise en forme, si cela ne correspond pas à ce que tu souhaites, on peut modifier ou compléter...

Cordialement.

Wow cela fonctionne parfaitement.... sur la majorité des enregistrements mais parfois il y a un message d'erreur : erreur d’exécution 9... l'indice n appartient pas a la sélection. Si je regarde le débogueur cela vient de:

Tbl(i, 4) = Trim(Split(Tmp(j), "à")(1))

Je suis parvenu a isoler au moins un des enregistrements a problème. En fait cela venait du fait que la ville était sur sur deux lignes au lieu d'une. Il y avait comme un retour de chariot après le premier mot de la ville.

Le hic est qu'il doit y en avoir d'autres. Y-a-t-il une possibilité de voir la ligne ou le débogueur stoppe ?

Merci.

Bdsa

Bonjour,

En cas d'erreur, après avoir cliqué sur débogage, tu regardes la valeur de i au moment de l'erreur : il suffit de survoler i avec le curseur dans le code, sa valeur s'affiche dans une infobulle. Cela te donne la ligne de la feuille qui provoque l'erreur...

Tu sors les cas à problème pour que l'on puisse voir si on peut les faire entrer dans le moule (en fait plutôt modifier le moule...)

Ce n'est pas le "Retour chariot" (caractère 13) mais le saut de ligne (caractère 10).

On éclate le contenu de la cellule avec Split sur ce caractère (Chr(10)), ce qui d'une part fait de chaque ligne de texte un élément de tableau, et d'autre part l'élimine.

On est parti d'une situation à 2 lignes produisant un tableau :

NomPrénom

DatNaissLieuNaiss

dont il fallait ensuite éclater chaque élément...

On s'est trouvé dans une situation à 3 lignes produisant :

NomPrénom

DatNaissLieuNaiss

Le premier élément (indice 0) ne bougeant pas, si l'indice le plus élevé était 1 on était dans le cas initial, si 2 dans le dernier cas. On distinguait bien ces deux situations.

Mais maintenant, il s'avère que l'on pourra trouver deux situations supplémentaires :

NomPrénom

Lieu(partie)

où là le programme actuel prendra la ligne DateetLieu comme nom marital, et dans la dernière il cherchera le à pour séparer la date du lieu en pure perte d'où erreur...

Il va donc falloir ajouter un teste de façon à distinguer les deux situations où le tableau comporte 3 éléments.

Et également prévoir le cas à 4 éléments :

NomPrénom

Lieu(partie)

A priori, on peut encore digérer ce problème !

Evidemment, chaque fois que l'on rencontre une situation imprévue, il faut rajouter des tests, cela allonge un peu, mais tant qu'on n'est pas dans une situation où on ne pourra pas trouver de test permettant décider quel est le cas entre deux d'entre eux, on doit pouvoir traiter.

A terme, il serait utile de pouvoir distinguer les nouveaux cas survenants (s'il y en a encore), c'est à dire déterminer qu'on est dans un cas qui ne se rattache à aucun des cas répertoriés, avant qu'il ne provoque une erreur...

Pour le moment c'est l'erreur qui permet d'identifier de nouveaux cas...

Traitons d'abord la dernière situation...

Cordialement.

Bonjour,

merci encore pour ces explications détaillées qui montre combien la programmation est complexe.

Donc j'ai repris le fichier ligne par ligne et voila quelques exemples que j'ai ajouté à la liste(lignes 11 a 14). le problème semble venir du lieu de naissance qui est scindé sur certains enregistrements sur deux lignes. En faisant le test de regrouper le lieu sur une ligne la macro fonctionne sans anicroches.

Merci.

Bdsa

10liste-client.xlsx (10.76 Ko)

Je vois aussi un autre point à affiner :

BLANC - JOCELYBE BENJAMINE GEORGETTE

- NOIR-BOUTHILLIER

Né(e) le 03/01/1945 à 04 DIGNE-LES-BAINS (ALPES-DE-HAUTE-

PROVENCE)

COURTEPAILLE - Josephine Marie Paule

- PLEURE-IVAHNOHE

Né(e) le 01/01/1962 à 69 LYON 09 (RHONE)

Nom marital avec trait d'union, que le programme va actuellement supprimer. Il n'y avait jusqu'à présent de trait d'union que comme séparateur.

Si l'on peut être sûr que en tant que séparateur il est toujours entouré d'espaces, on peut jouer là-dessus pour distinguer les deux utilisations ?

Il n'y a malheureusement pas de constance on dirait dans le nom marital. Je joins une nouvelle liste avec quelques lignes supplémentaires.

Merci.

Bdsa

15liste-client.xlsx (11.52 Ko)

Je vais examiner tout ça...

A+

Une nouvelle version, qui m'a l'air de fonctionner sur l'échantillon élargi...

Sub ReclasserDonnées()
    Dim Tbl(), Tmp, d, n%, i%, j%, nn%
    With Worksheets("Feuil1")
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        ReDim Tbl(n, 9)
        For i = 1 To n
            Tmp = Split(.Cells(i, 1), Chr(10))
            For j = 0 To 1
                Tbl(i, j) = Trim(Split(Tmp(0), "-")(j))
            Next j
            j = UBound(Tmp)
            If Tmp(1) Like "Né*" Then
                nn = 1
            Else
                Tbl(i, 2) = Trim(Replace(Tmp(1), "-", "", 1, 1))
                nn = 2
            End If
            If j > nn Then
                Do While j > nn
                    Tmp(j - 1) = Tmp(j - 1) & Tmp(j): j = j - 1
                Loop
            End If
            d = Trim(Split(Tmp(j), "à")(0))
            If IsNumeric(Right(d, 4)) Then
                d = DateValue(Right(d, 10))
                If Year(d) < 1900 Then d = Format(d, "dd/mm/yyyy")
                Tbl(i, 3) = d
            End If
            Tbl(i, 4) = Trim(Split(Tmp(j), "à")(1))
            If .Cells(i, 2) <> "" Then
                Tmp = Split(.Cells(i, 2))
                For j = UBound(Tmp) To 0 Step -1
                    If Val(Tmp(j)) >= 1000 Then
                        If InStr(Tmp(j), Chr(10)) > 0 Then
                            d = Split(Tmp(j), Chr(10))(0)
                            Tmp(j) = Replace(Tmp(j), d, "@@")
                        Else
                            d = Tmp(j): Tmp(j) = "@@"
                        End If
                        Exit For
                    End If
                Next j
                Tmp = Split(Join(Tmp), "@@")
                Tbl(i, 5) = Trim(Tmp(0))
                Tbl(i, 6) = Trim(Tmp(1))
                Tbl(i, 7) = Mid(d, 6, Len(d))
                Tbl(i, 8) = Format(Val(d), "00000")
            End If
            Tbl(i, 9) = .Cells(i, 3)
        Next i
    End With
    Tbl(0, 0) = "Nom": Tbl(0, 1) = "Prénom": Tbl(0, 2) = "Nom marital"
    Tbl(0, 3) = "Date de naissance": Tbl(0, 4) = "Lieu de naissance"
    Tbl(0, 5) = "Adresse": Tbl(0, 6) = "Complément": Tbl(0, 7) = "Ville"
    Tbl(0, 8) = "CP": Tbl(0, 9) = "Nationalité"
    With Worksheets("Feuil2").Range("A1")
        .CurrentRegion.Clear
        With .Resize(n + 1, 10)
            .Value = Tbl
            .WrapText = False
            With .Rows(1)
                .HorizontalAlignment = xlCenter
                .Font.Bold = True: .Font.Italic = True
            End With
            With .Columns(4)
                .NumberFormat = "dd/mm/yyyy"
                .HorizontalAlignment = xlRight
            End With
            .Columns(9).NumberFormat = "00000"
            .Columns.AutoFit
            .Rows.RowHeight = 15
            .Worksheet.Activate
        End With
    End With
End Sub

Aux prochaines nouveautés qui dérogeront !

Cordialement.


Bonjour,

Un énorme MERCI pour le temps que vous avez pris pour ce code. Cela fonctionne a merveille. Je vais essayer de comprendre le tout maintenant

Merci encore.

Bdsa

Rechercher des sujets similaires à "extraire donnees deux lignes meme"