Macro Noms Prenoms composé

[lionelch1]

Bonjour ,

J’ai une petite macro pour séparer les Noms des Prénoms ,
Mais avec les noms composé ceci ne marche pas ,
Je recherche la bonne macro , ( fichier joint )

Merci
Lionel

 

[Gareth]

Re : Macro Noms Prenoms composé

Bonsoir,

Ci-joint une solution à tester et sans doute à optimiser.

 

[ROGER2327]

Re : Macro Noms Prenoms composé

Bonsoir lionelch1.

Un essai :​

Sub toto()
Dim i%, j%, l&, x, u$(2)
    For l = 1 To 1000
        x = Split(CStr(Cells(l, 3).Value))
            If UBound(x) >= 0 Then
            For i = 0 To UBound(x)
                If UCase(x(i)) = x(i) Then
                    u(0) = u(0) & x(i) & " "
                ElseIf Left$(x(i), 1) = "(" Then
                    For j = i To UBound(x)
                        u(2) = u(2) & x(j) & " "
                    Next
                    Exit For
                Else
                    u(1) = u(1) & x(i) & " "
                End If
            Next
            For j = 0 To 2
                u(j) = Trim(u(j))
            Next
            Cells(l, 3).Offset(, 1).Resize(1, 3).Value = u
            Erase u
        End If
    Next
End Sub

ROGER2327
#6523

Dimanche 22 Pédale 140 (Saint Sengle, Déserteur - fête Suprême Seconde)
26 Ventôse An CCXXI, 7,5151h - pissenlit
2013-W11-6T18:02:10Z


_________
P.s. : Bonsoir Gareth. Nous sommes à peu près sur la même longueur d'onde...

 

[BOISGONTIER]

Re : Macro Noms Prenoms composé

Bonsoir,

Cf PJ

Function Nom(c)
  Application.Volatile
  Set obj = CreateObject("vbscript.regexp")
  obj.Pattern = "([A-Z'ÔË]{2,}\s*-?)+"
  Set a = obj.Execute(c)
  If a.Count > 0 Then Nom = a(0) Else Nom = ""
End Function

Function Prénom(c)
  Application.Volatile
  Set obj = CreateObject("vbscript.regexp")
  c = Replace(Replace(Replace(c, "M.", ""), "Mme", ""), "Mle", "")
  obj.Pattern = "([A-Za-z][a-zëéèô]+\s*-?)+"
  Set a = obj.Execute(c)
  If a.Count > 0 Then Prénom = a(0) Else Prénom = ""
End Function

Function Ville(c)
  Application.Volatile
  p1 = InStr(c, "(")
  If p1 > 0 Then
    p2 = InStr(p1 + 1, c, ")")
    If p2 > 0 Then Ville = Mid(c, p1 + 1, p2 - p1 - 1): Exit Function
  End If
  Ville = ""
End Function

JB

 

[lionelch1]

Re : Macro Noms Prenoms composé

Merci ,
Pour Gareth et Roger cela fonctionne sauf si exemple j'ai DE MARETTE Charles (80)
avec 80 entre parenthese au lieu de lettres
pour Boisgontier ceci fonctionne sauf que je ne sais pas comment mettre cela en macro avec un boutons ?
Lionel

 

[BOISGONTIER]

Re : Macro Noms Prenoms composé

Ce sont des fonctions perso.Il n'y a pas besoin de bouton.

Solution bouton en pj (+compliqué et - souple )

jb

 

[ROGER2327]

Re : Macro Noms Prenoms composé

Re..

(...)
Pour Gareth et Roger cela fonctionne sauf si exemple j'ai DE MARETTE Charles (80)
avec 80 entre parenthese au lieu de lettres
(...)

Sub toto()
Dim i%, j%, l&, x, u$(2)
    For l = 1 To 1000
        x = Split(CStr(Cells(l, 3).Value))
            If UBound(x) >= 0 Then
            For i = 0 To UBound(x)
                If Left$(x(i), 1) = "(" Then
                    For j = i To UBound(x)
                        u(2) = u(2) & x(j) & " "
                    Next
                    Exit For
                ElseIf UCase(x(i)) = x(i) Then
                    u(0) = u(0) & x(i) & " "
                Else
                    u(1) = u(1) & x(i) & " "
                End If
            Next
            For j = 0 To 2
                u(j) = Trim(u(j))
            Next
            Cells(l, 3).Offset(, 1).Resize(1, 3).Value = u
            Erase u
        End If
    Next
End Sub

ROGER2327
#6524

Dimanche 22 Pédale 140 (Saint Sengle, Déserteur - fête Suprême Seconde)
26 Ventôse An CCXXI, 8,1546h - pissenlit
2013-W11-6T19:34:16Z

 

[lionelch1]

Re : Macro Noms Prenoms composé

Merci Boisgontier et Roger , Les deux marchent Impeccable
pour Boisgontier merci aussi de l'avoir fait avec le bouton Hi Hi !
Une petite derniere chose et je vous laisse tranquille ,
J'ai plusieurs fichiers aussi dans le meme format sauf !
que mes Noms et Prenoms ne sont pas dans la colonne C mais dans la Colonne H
et ou je voudrais les mettres dans les colonnes suivantes I-J-K ( comme vous l'avez fait )
Encore merci
lionel
Modification : C'est bon j'ai trouvé en faisant plusieurs essais ,
j'ai remplacé les " Cells (1, 3) " par " Cells (1, 8) "
je ne sais pas comment on fait mais on peut noter Sujet Résolu