Détécter derniere majuscule d'une cellule

  • Initiateur de la discussion Initiateur de la discussion dimbad
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

dimbad

XLDnaute Nouveau
Bonjour,

Dans mon fichier, je veux identifier la dernière majuscule de la cellule pour pouvoir ensuite séparer les données. Dans la même cellule, il y a en fait le nom et le prénom regroupé sans espace.
Merci de votre aide
 

Pièces jointes

Bonjour Dimbad, bonjour le forum,

Peut-être comme ça :

VB:
Sub Macro1()
Dim O As Worksheet
Dim TV As Variant
Dim I As Integer
Dim C As Integer
Dim TL() As Variant

Set O = Worksheets("Feuil1")
With O.Range("A1").CurrentRegion
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
End With
TV = O.Range("A1").CurrentRegion
ReDim TL(1 To 1, 1 To UBound(TV, 1))
TL(1, 1) = TV(1, 1)
For I = 2 To UBound(TV, 1)
    For C = 1 To Len(TV(I, 1))
        If Asc(Mid(TV(I, 1), C, 1)) > 90 Then
            TL(1, I) = Left(TV(I, 1), C - 2) & " " & Mid(TV(I, 1), C - 1)
            Exit For
        End If
    Next C
Next I
O.Range("A1").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL)
End Sub
 
Bonjour à tous,

Avec 2 fonctions et un bout de formule :

VB:
Option Explicit

Function Maj$(ByVal Texte$)
    Dim I%, Car$
    Do While Texte <> ""
        I = InStr(1, Texte, "")
        If I > 0 Then Car = Left$(Texte, I) Else Car = Texte: I = Len(Texte)
        If Car = UCase(Car) Then Maj = Maj & Car
        Texte = Mid$(Texte, I + 1)
    Loop
    Maj = Trim(Maj)
    If Right$(Maj, 1) = "" Then Maj = Left$(Maj, Len(Maj) - 1)
End Function

Function Minus$(ByVal Texte$)
    Dim I%, Car$
    Do While Texte <> ""
        I = InStr(1, Texte, "")
        If I > 0 Then Car = Left$(Texte, I) Else Car = Texte: I = Len(Texte)
        If Car = LCase(Car) Then Minus = Minus & Car
        Texte = Mid$(Texte, I + 1)
    Loop
    Minus = Trim(Minus)
    If Right$(Minus, 1) = "" Then Minus = Left$(Minus, Len(Minus) - 1)
End Function

A+ à tous
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
2
Affichages
223
Réponses
17
Affichages
271
Retour