extraire nom propre d'une cellule

je voudrais extraire seulement les noms qui sont en majuscules dans la
colonne B

Un petit code de notre vacancier Daniel M.

=XTraitMaj(A1)

Function XTraitMAJ(Txt$) As String
Dim RE As Object, MS As Object
Dim i As Integer, s As String, tmp As String

Set RE = CreateObject("VBScript.RegExp")
RE.Ignorecase = True: RE.Global = True
RE.Pattern = "s?S+s?"
Set MS = RE.Execute(Txt)

For i = 0 To MS.Count - 1
If MS(i).Value = UCase(MS(i).Value) Then
s = s & " " & Trim(MS(i).Value)
End If
Next i
XTraitMAJ = Mid(s, 2)
End Function


Starwing

Merci beaucoup Daniel cela fonctionne.

juste une petite question

Si l'utilisateur a tapé quelque chose derrière le nom propre
il prend le nom + ce qui suit

que faudrait-il modifé à cette procédure ? Au cas ou

merci de l'aide

claude

Un petit code de notre vacancier Daniel M.

=XTraitMaj(A1)

Function XTraitMAJ(Txt$) As String
Dim RE As Object, MS As Object
Dim i As Integer, s As String, tmp As String

Set RE = CreateObject("VBScript.RegExp")
RE.Ignorecase = True: RE.Global = True
RE.Pattern = "s?S+s?"
Set MS = RE.Execute(Txt)

For i = 0 To MS.Count - 1
If MS(i).Value = UCase(MS(i).Value) Then
s = s & " " & Trim(MS(i).Value)
End If
Next i
XTraitMAJ = Mid(s, 2)
End Function


Starwing

Claude,

Il ne prend que les mots tout en majuscules.

Donne un exemple précis d'une entrée et du résultat attendu, afin qu'on puisse
comprendre ton problème et ajuster au besoin.

Salutations,

Daniel M.

"petit" <claude@claude.be> wrote in message
news:%23AJyM%234tEHA.1464@TK2MSFTNGP15.phx.gbl...

Merci beaucoup Daniel cela fonctionne.

juste une petite question

Si l'utilisateur a tapé quelque chose derrière le nom propre
il prend le nom + ce qui suit

que faudrait-il modifé à cette procédure ? Au cas ou

merci de l'aide

claude

Un petit code de notre vacancier Daniel M.

=XTraitMaj(A1)

Function XTraitMAJ(Txt$) As String
Dim RE As Object, MS As Object
Dim i As Integer, s As String, tmp As String

Set RE = CreateObject("VBScript.RegExp")
RE.Ignorecase = True: RE.Global = True
RE.Pattern = "s?S+s?"
Set MS = RE.Execute(Txt)

For i = 0 To MS.Count - 1
If MS(i).Value = UCase(MS(i).Value) Then
s = s & " " & Trim(MS(i).Value)
End If
Next i
XTraitMAJ = Mid(s, 2)
End Function


Starwing