Sujet Précédent Sujet Suivant

Excel séparer MAJUSCULESMinuscules

Résolu/Fermé
Peo_o Messages postés 85 Date d'inscription mercredi 8 août 2007 Statut Membre Dernière intervention 8 mai 2015 - 22 avril 2011 à 11:40
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 - 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
A voir également:

6 réponses

Réponse 1 / 6
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
22 avril 2011 à 15:50
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
1
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 745
22 avril 2011 à 16:39
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...
0
ccm81 Messages postés 10855 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 29 avril 2024 2 404
22 avril 2011 à 20:27
bonsoir michel_m

même chose

cordialement
0
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
23 avril 2011 à 07:57
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/
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 745
27 avril 2011 à 09:35
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+
0
Réponse 2 / 6
Ricky38 Messages postés 4349 Date d'inscription samedi 15 mars 2008 Statut Contributeur Dernière intervention 2 novembre 2013 1 458
22 avril 2011 à 11:52
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
0
Réponse 3 / 6
Peo_o Messages postés 85 Date d'inscription mercredi 8 août 2007 Statut Membre Dernière intervention 8 mai 2015 2
22 avril 2011 à 12:29
hey Ricky38,

merci pour ta vba ...

Je vais manger et je test ça en revenant


a tout' !!!!
0
Réponse 4 / 6
Peo_o Messages postés 85 Date d'inscription mercredi 8 août 2007 Statut Membre Dernière intervention 8 mai 2015 2
22 avril 2011 à 16:12
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
0
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
Modifié par michel_m le 22/04/2011 à 17:21
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
0
Peo_o Messages postés 85 Date d'inscription mercredi 8 août 2007 Statut Membre Dernière intervention 8 mai 2015 2
25 avril 2011 à 16:53
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 ...
0
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
25 avril 2011 à 17:41
Je t'ai indiqué que je ne dérangerai plus. aies la décence de faire de m^me.
0

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

Posez votre question
Réponse 5 / 6
crapoulou Messages postés 28158 Date d'inscription mercredi 28 novembre 2007 Statut Modérateur, Contributeur sécurité Dernière intervention 16 avril 2024 7 990
22 avril 2011 à 16:24
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 ;-).
0
Réponse 6 / 6
Peo_o Messages postés 85 Date d'inscription mercredi 8 août 2007 Statut Membre Dernière intervention 8 mai 2015 2
25 avril 2011 à 16:55
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 !!!
0
crapoulou Messages postés 28158 Date d'inscription mercredi 28 novembre 2007 Statut Modérateur, Contributeur sécurité Dernière intervention 16 avril 2024 7 990
25 avril 2011 à 18:39
C'est bon là.
Tu as juste à cliquer directement sur "Marquer comme résolu". Ne passe pas par tes mails.

Bonne continuation.
0