Excel séparer MAJUSCULESMinuscules Résolu/Fermé

Question

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

Ricky38 · Answer

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

Peo_o · Answer

hey Ricky38,

merci pour ta vba ...

Je vais manger et je test ça en revenant


a tout' !!!!

michel_m · Answer

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

Peo_o · Answer

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

crapoulou · Answer

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 ;-).

Peo_o · Answer

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 !!!