Détécter derniere majuscule d'une cellule

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

  • Classeur1.xlsx
    13.5 KB · Affichages: 41

Robert

XLDnaute Barbatruc
Repose en paix
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
 

JCGL

XLDnaute Barbatruc
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

  • JC Sépare MAJUS et Minus dans chaîne.xlsm
    20.7 KB · Affichages: 19

Lolote83

XLDnaute Barbatruc
Salut à tous,
Le temps d'essayer de rédiger ma macro que vous êtes déjà là.
Je poste tout de même.
Je viens de rajouter par fonction personalisée !!!!!
@+ Lolote83
 

Pièces jointes

  • Copie de DIMBAD - Extraire nom prénom.xlsm
    17.6 KB · Affichages: 25
Dernière édition:

Discussions similaires

Réponses
9
Affichages
393

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
312 177
Messages
2 085 972
Membres
103 073
dernier inscrit
MSCHOE16