Excel séparer MAJUSCULESMinuscules

Résolu

Peo_o Messages postés 85 Date d'inscription Statut Membre Dernière intervention -
pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention - 27 avril 2011 à 09:35

Bonjour a tous ! ! ! ! J'espere poster au bon endroit !! (émoticone gêné)

Pour commencer, je ne connais pas le langage macro... (reémoticone gêné)

Et aucun forum ne trait de ma problématique... (reémoticone gêné)

j'ai une liste de noms et prénoms dans la colonne A et souhaite les séparer... différents cas de figure dans un même fichier :

1 Soit : COMMENTCAMARCHEPaul

2 Soit : BernadetteCOMMENTCAMARCHE

3 Soit [Optionnel]
le cas en plus (mais pouvant certainement être traité à partir des 2 premiers exemples) :

COMMENTBernadetteCAMARCHE (nom d'épouse à la fin)

Il n'y a donc AUCUN ESPACE !!!

Serait t-il donc possible de faire une macro, ou même plusieurs (si trop complexe) permettant de séparer les noms des prénoms suivant cette situation particulière ???

Pour gage de ma bonne volonté je vous fourni la base d'une macro qui m'est très utile pour séparer des "NOMS Prénoms" mais qui ont un espace entre les deux... peut être une base de travail ??

Par avance MERCI !!!!!!!!!! en espérant vous avoir donné des infos claires... (Emoticone clin d'oeil ;-)

Séparation des NOMS Prénoms AVEC ESPACE ENTRE LES DEUX :

Sub SeparNOMSPrenomS()
Dim i As Integer
Dim vDerniereLigne
Dim Chaine As String
Dim vASC As Integer
Dim x As Integer, y As Integer
vDerniereLigne = 21000
For i = 1 To 21000
Chaine = Range("A" & i).Value
Chaine = Replace(Chaine, "=- ", "")
Chaine = Replace(Chaine, "=-", "")
Chaine = Replace(Chaine, "=", "")
Chaine = Replace(Chaine, " ", " ")
Chaine = Replace(Chaine, " ", " ")
Chaine = Replace(Chaine, " ", " ")
Chaine = Replace(Chaine, " ", " ")
Chaine = Replace(Chaine, " ", " ")
Chaine = Replace(Chaine, " ", " ")
Chaine = Replace(Chaine, " ", " ")
Chaine = Replace(Chaine, "IVI", "M")
Chaine = Replace(Chaine, "1 .", "L")
Chaine = Replace(Chaine, " Y ", "-Y ")
Chaine = Replace(Chaine, "AUce", "Alice")
Chaine = Replace(Chaine, "/Uice", "Alice")
Chaine = Replace(Chaine, "OUvier", "Olivier")
Chaine = Replace(Chaine, "EUe", "Eue")
Chaine = Replace(Chaine, "GUbert", "Gilbert")
Chaine = Replace(Chaine, "EUsabeth", "Elisabeth")
Chaine = Replace(Chaine, "EUane", "Eliane")
Chaine = Replace(Chaine, "AUne", "Aline")
Chaine = Replace(Chaine, "IVI", "M")
Chaine = Replace(Chaine, "IVI", "M")
Chaine = Replace(Chaine, " - ", "- ")
Chaine = Replace(Chaine, " ,1", ",1")
Chaine = Replace(Chaine, " 1 1 ", "1-1 ")
Chaine = Replace(Chaine, " ,0N ", ",0N ")
Chaine = Replace(Chaine, "Ep.", " Ep. ")
Chaine = Replace(Chaine, " ", " ")
Chaine = Replace(Chaine, " J ", "-J")
y = 1
Do
x = InStr(y, Chaine, " ")
If x > 0 Then
vASC = Asc(Mid(Chaine, x + 2, 1))
Else
vASC = 0
End If
y = x + 1
Loop Until vASC < 65 Or vASC > 90 Or x = 0
If vASC <> 0 Then
Range("B" & i).Value = UCase(Left(Chaine, x - 1))
Range("C" & i).Value = (Right(Chaine, Len(Chaine) - x))
End If
Next i
End Sub

Configuration: Windows Vista / Firefox 3.6.16
Excel 2007

Afficher la suite

A voir également:

Excel séparer MAJUSCULESMinuscules
Liste déroulante excel - Guide
Word et excel gratuit - Guide
Déplacer colonne excel - Guide
Si ou excel - Guide
Excel moyenne - Guide

6 réponses

Réponse 1 / 6

michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention 3 314

Bonjour,

valable pour 1 à 3 éléments Prénom avec nom Propre

Function extraire_voy(texto As Range)
Dim reg As Object
Dim extraction As Object

    Set reg = CreateObject("vbscript.regexp")
    reg.Global = False
    reg.Pattern = "(\w[a-z()]{1,})"
    Set extraction = reg.Execute(texto)
    For Each maj In extraction
        extraire_voy = maj.Value
    Next maj
  
End Function

Sub separe_majmin()
Dim cellule As Range
Set cellule = Range("B3")
Dim voyel As String, vol_nb As Byte, pos As Byte

     voyel = extraire_voy(cellule)
     voy_nb = Len(voyel)
     pos = Application.Search(voyel, cellule)

     Range("D3") = Left(cellule, pos - 1)
     Range("E3") = voyel
     Range("F3") = Right(cellule, Len(cellule) - (pos + voy_nb - 1))


End Sub

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

Salut Michel_m,
1- merci pour la macro! (je le fais en lieu et place de Peo_o... car elle va me servir)
2- maj dans la fonction, doit être déclarée As quoi? Perso je l'ai déclarée en Variant, ça fonctionne, mais suis pas sur que ce soit la meilleure solution...

ccm81 Messages postés 10909 Date d'inscription Statut Membre Dernière intervention 2 433

bonsoir michel_m

même chose

cordialement

michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention 3 314

Merci tous les 2

maj devrait s'appeler "voy" (à l'origine extraction de majuscules)

c'est un objet de type Match cad dans les expressions rationnelles, correspondance entre la donnée étudiée et le modèle (pattern)

pour "s'initier" aux expressions rationnelles, bon courage quand m^me :o), ce tuto de Caféine
https://cafeine.developpez.com/access/tutoriel/regexp/

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

Salut michel,
Parfait, comme à ton habitude.
J'ai regardé ce tuto, je pense qu'il vaux le coup d'oeil et même d'y regarder à 3-4 fois...
Merci encore
A+

Réponse 2 / 6

Ricky38 Messages postés 4349 Date d'inscription Statut Contributeur Dernière intervention 1 462

Salut,

voici un code VBA pour 2 noms

Sub Tst2()
Dim LastRow As Long, i As Long, j As Long
Dim L As Long, s As String, c As String * 1
Dim s1 As String, s2 As String

    LastRow = Feuil1.Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To LastRow
        L = Len(Feuil1.Range("A" & i))
        s = Feuil1.Range("A" & i)
        For j = L To 1 Step -1
            c = Mid$(s, j, 1)
            If c = LCase$(c) Then
                s1 = Left$(s, j)
                s2 = Right$(s, L - j)
                Exit For
            End If
        Next j
        Feuil1.Range("B" & i) = s1
        Feuil1.Range("C" & i) = s2
    Next i
End Sub

Pour 3 je ne sais pas faire car mes connaissances en VBA sont très limitées ;)
https://www.excel-downloads.com/threads/comment-separer-les-caracteres-en-majuscules-des-caracteres-en-minuscules.157344/

bonne journée

Réponse 3 / 6

Peo_o Messages postés 85 Date d'inscription Statut Membre Dernière intervention 2

hey Ricky38,

merci pour ta vba ...

Je vais manger et je test ça en revenant

a tout' !!!!

Réponse 4 / 6

Peo_o Messages postés 85 Date d'inscription Statut Membre Dernière intervention 2

Merci pour le lien !!! j'avais essayé déjà les propositions, mais il manqué une boucle pour traiter les lignes suivantes et quelques petits details concernant la gestion des tiraits (considéré par défaut comme une minuscule)
Et également, qu'il mette les resultats dans les colones B et C

Voilà qui est fait !!!

je vous post la macro et merci encore Ricky38 :

Sub MajMin2()
Dim LastRow As Long
Dim cel As String
'Set cel = [A10] à adapter
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For j = 1 To LastRow
cel = Range("A" & j).Value
For i = 1 To Len(RTrim(cel))
x = Mid(cel, i, 1)
y = Mid(cel, i + 1, 1)
Z = Mid(cel, i + 2, 1)

If (x = LCase(x) Or y = LCase(y)) And x <> "-" And y <> "-" And i <> Len(RTrim(cel)) Then _
txt1 = txt1 & x

If x <> LCase(x) And y <> LCase(y) And y <> "" Then _
txt2 = txt2 & x

If x = LCase(x) And i = Len(RTrim(cel)) Then _
txt1 = txt1 & x

If x <> LCase(x) And i = Len(RTrim(cel)) Then _
txt2 = txt2 & x

If x <> LCase(x) And y = "-" Then _
txt2 = txt2 & x

If x = "-" And y <> LCase(y) And Z <> LCase(Z) Then _
txt2 = txt2 & x

If y <> LCase(y) And x = "-" And Z = LCase(Z) Then _
txt1 = txt1 & x

If y = "-" And x = LCase(x) Then _
txt1 = txt1 & x

If x = "-" And y = LCase(y) Then _
txt1 = txt1 & x

Next i
Range("B" & j).Value = txt1
Range("C" & j).Value = txt2
txt1 = ""
txt2 = ""
Next j
End Sub

michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention 3 314

Excuses moi de t'avoir dérangé Peo_o en essayant de t'aider, mais crois moi, j'ai noté ton pseudo, ca ne se reproduira plus

Peo_o Messages postés 85 Date d'inscription Statut Membre Dernière intervention 2

Bonjour michel_m !!!

En relisant le post entièrement je me suis rendu compte que je n'avais pas vu tes réponses !!! (d'ou mon étonnement en découvrant le dernier message que tu m'adressais !!) Je te présente donc toutes mes excuses !! Garde à l'esprit que certainement personnes n'ont pas l'habitude des forums et de l'informatique en générale !! c'est ce qui fait la valeur, en particuliers de ce site, d'ailleurs !!!! donc merci à toi michel_m pour ton aide et MERCI EGALEMENT A TOUTE LA COMMUNAUTE CCM? Pour votre aide fort utile !!!!!!!

Et pour finir michel_m, me feras tu le plaisir de me retirer de ta black liste ??? ;-)

maintenant je répond à crapoulou, allé hop, une ligne en dessous ...

michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention 3 314

Je t'ai indiqué que je ne dérangerai plus. aies la décence de faire de m^me.

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 6

crapoulou Messages postés 28195 Date d'inscription Statut Modérateur, Contributeur sécurité Dernière intervention 8 013

Bonjour Peo_o,

Tu peux changer le statut de la discussion pour le passer en [Résolu] par toi-même :
https://www.commentcamarche.net/infos/25917-marquer-un-fil-de-discussion-comme-etant-resolu/

Je te laisse le faire ;-).

Réponse 6 / 6

Peo_o Messages postés 85 Date d'inscription Statut Membre Dernière intervention 2

je continue mes mea culpa en serie !!!! Bonjour Crapoulou !!!

je pensai l'avoir fait en cliquant sur le message "à signaler" -> "signaler comme résolu"

je réctifie de suite !!!

merci et bon lundi-Pascal !!!

crapoulou Messages postés 28195 Date d'inscription Statut Modérateur, Contributeur sécurité Dernière intervention 8 013

C'est bon là.
Tu as juste à cliquer directement sur "Marquer comme résolu". Ne passe pas par tes mails.

Bonne continuation.

Votre réponse