Excel séparer MAJUSCULESMinuscules

Résolu
Peo_o -  
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

6 réponses

  1. michel_m Contributeur
    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
    1. pijaku Modérateur
      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
    2. ccm81
      bonsoir michel_m

      même chose

      cordialement
      0
    3. michel_m Contributeur
      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
    4. pijaku Modérateur
      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
  2. Ricky38 Contributeur
    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
    1. Peo_o Auteur
      hey Ricky38,

      merci pour ta vba ...

      Je vais manger et je test ça en revenant

      a tout' !!!!
      0
      1. Peo_o Auteur
        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
        1. michel_m Contributeur
          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
        2. Peo_o Auteur
          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
        3. michel_m Contributeur
          Je t'ai indiqué que je ne dérangerai plus. aies la décence de faire de m^me.
          0
      4. Peo_o Auteur
        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
        1. crapoulou Modérateur
          C'est bon là.
          Tu as juste à cliquer directement sur "Marquer comme résolu". Ne passe pas par tes mails.

          Bonne continuation.
          0