Extraire noms et prénoms d'une chaine de texte sans règle logique évidente

Question

J'ai une série de lignes de doublets de type Qualité - NOM- Prénom - Qualité - NOM - Prénom que je souhaite pouvoir dissocier et assigner à des variables.
Jusque là rien de bien sorcier... je récupére les qualités sans problème.

Mais là où je sèche c'est que je peine à trouver une règle pour isoler mes noms et prénoms.
Les noms sont en majuscules, c'était une piste évidente de récupération, mais certains patronymes à particules ne le sont pas complètement, ex: "de LA PARTICULE"
Les prénoms sont tous sur le même modèle (première lettre en majuscule, le reste en minuscule) mais ce qui pose difficulté c'est la présence de certains prénoms composés sans tiret, ex: "Jean Baptiste".

Comment récupérer proprement mes qualite1, nom1, prenom1, qualité2, nom2, prenom2 ?

Est-ce même seulement possible ? J'ai tourné autour de plusieurs solutions (la casse, compter les espaces, etc.) mais je cale.

Merci à tou(te)s celles et ceux qui voudront bien se pencher sur mon fichier anonymisé pour tenter de m'aider!

BsAlv · Accepted Answer

Une autre autre façon...

78chris · Accepted Answer

Une version PowerQuery, peut-être simplifiable, qui découpe bien en Titre, Nom et Prénom X2...

mafraise · Accepted Answer

Bonjour guillaumeplougoulm , à tous ,

Une autre fonction personnalisée VBA à trois arguments : =TitreNomPrenom(monTexte, Lequel, Quoi) où :

monTexte est le texte source
Lequel est le rang de l’individu dont on veut extraire les informations (1 => première personne, 2 => 2ème personne, N => Nème personne...)
Quoi est l'information à extraire (1 => titre, 2 => Nom, 3 => Prénom)

Le code de la fonction dans module1:

Function TitreNomPrenom$(monTexte$, Lequel&, Quoi&)
Dim x$, nbr&, t, res, y, i&, j&, k&, n&

   If Quoi < 1 Or Quoi > 3 Then Exit Function
   x = Application.Trim(Replace(Replace(monTexte, "M. ", Chr(255) & "M. "), "Mme ", Chr(255) & "Mme "))
   If x = "" Then Exit Function
   nbr = Len(x) - Len(Replace(x, Chr(255), ""))
   If nbr < 1 Then Exit Function
   If Lequel < 1 Or Lequel > nbr Then Exit Function
   t = Split(Trim(x), Chr(255)): ReDim res(1 To 3 * nbr)
   For i = 1 To UBound(t)
      y = Split(Trim(t(i)))
      res(3 * n + 1) = y(0)
      For j = UBound(y) To 1 Step -1
         If UCase(y(j)) = y(j) Then Exit For
      Next j
      If j >= 1 Then
         For k = 1 To j: res(3 * n + 2) = res(3 * n + 2) & " " & y(k): Next k
         For k = j + 1 To UBound(y): res(3 * n + 3) = res(3 * n + 3) & " " & y(k): Next k
         res(3 * n + 2) = Trim(res(3 * n + 2)): res(3 * n + 3) = Trim(res(3 * n + 3))
      End If
      n = n + 1
   Next i
   TitreNomPrenom = res(3 * (Lequel - 1) + Quoi)
End Function

19guillaumeplougoulm-extraction-v1.xlsm (19.32 Ko)

Thibet · Answer

Voilà raccourci, Ctrl+E et la fonction concaténer "" pour espace entre les noms Bien à toi...

DjiDji59430 · Answer

Une autre façon ...