Extraire un texte en majuscule d'une cellule

Bonjour à tous,

J'ai la cellule suivante :

1001 PATTES Affiche de cinéma - 40x60 cm. - 1998 - Pixar, John Lasseter

J'essaie d'extraire le texte en majuscule d'une cellule "1001 PATTES" de cette cellule. Le texte qui suit est toujours en minuscule avec une première lettre en majuscule : "Affiche de cinéma"

D'autres exemples :

2 SOEURS Photos de film x6 - 21x30 cm. - 2003 - Kap-su Kim, Kim Jee-woon
20000 LIEUES SOUS LES MERS Photo de film N2 28x36 cm - 1954/R1971 - Kirk Douglas, Richard Fleischer
20000 LIEUES SOUS LES MERS Photo de presse N4 20x25 - 1954 / R1963 - Kirk Douglas, Richard Fleischer

J'ai 25000 lignes… merci d'avance pour votre aide

Bonne journée !

Lionel

Bonjour Diabolyo

Essai avec cette macro si tu supportes les macros . Adapte-la selon où tu veux mettre ton résultat

Sub ExtractionTitre()
    For lig = 2 To ActiveSheet.Range("A65536").End(xlUp).Row
        Txt = Cells(lig, 1)
        For k = 1 To Len(Txt)
            If Mid(Txt, k, 1) <> " " And Mid(Txt, k, 1) = LCase(Mid(Txt, k, 1)) And IsNumeric(Mid(Txt, k, 1)) = False Then Exit For
        Next
        Cells(lig, 2) = Left(Txt, k - 2)
        Txt = Mid(Txt, k - 1, Len(Txt))
        For k = 1 To Len(Txt)
            If IsNumeric(Mid(Txt, k, 1)) Then Exit For
        Next
    Next
End Sub

Cordialement

Merci, je n'ai jamais utilisé les macros mais je vais essayer !

bonjour diabolyo, Patty5046,

même principe que Patty mais avec des mots au lieu des charactères

Sub ExtractionTitre()
     Dim X, c, i, sp
     For Each c In ActiveSheet.Columns("A").SpecialCells(xlConstants)
          sp = Split(c)                      'séparer les mots
          For i = 0 To UBound(sp)            'boucler les mots
               If Len(sp(i)) > 1 Then        'longueur du mot >1
                    Select Case Asc(Mid(sp(i), 2, 1))     '2ième charactère
                         Case 97 To 122      'est miniscule
                              X = sp         'sauvegarder les mots -1
                              ReDim Preserve X(i - 1)
                              c.Offset(, 1).Value = Join(X)     'joindre ces mots
                              Exit For
                    End Select
               End If
          Next
     Next
End Sub

J'ai un message d'erreur :

capture d e cran 2024 01 29 a 16 46 42

J'essaie de comprendre, la colonne traitée est la colonne D, mais dans quelle colonne va le résultat ?

Désolé, je suis un gros newbie, je n'ai jamais utilisé VBA ;)

Bonjour à tous !

Une proposition formule pour un texte en A1 ? :

=LET(
     t;A1;
     GAUCHE(t;EQUIVX(1;--(UNICODE(STXT(t;SEQUENCE(NBCAR(t));1))>96);0)-3)
)

A étirer vers le bas.

Bonjour à tous

Dans nos macros, le résultat apparait dans la colonne d'à côté, à droite, donc si colonne D en E

As-tu un petit extrait de ton fichier (les 1ères lignes) pour que l'on voie si tu n'y arrives pas ?

Merci pour la formule ! ça fonctionne ! par contre quand j'étire vers le bas, non…

001 OPERATION JAMAIQUE Affiche de film entoilée - 35x55 cm. - 1965 - Larry Pennell, Richard Jackson001 OPERATION JAMAIQUE
10 CLOVERFIELD LANE Affiche de film 120x160 cm - 2016 - John Goodman, Dan Trachtenberg2 OPERATION JAMAIQUE
10 CLOVERFIELD LANE Affiche de film 40x60 cm - 2016 - John Goodman, Dan Trachtenberg3 OPERATION JAMAIQUE

Patty5046, Concernant la macro, je dois mal m'y prendre, j'ouvre une nouvelle macro, je copie/colle la macro en remplaçant A65366 par D2, je fais "play" et rien ne se passe …

Bonjour à tous de nouveau !

Pourquoi ne pas joindre un classeur (pas une image....) ?

image

Re

Patty5046, Concernant la macro, je dois mal m'y prendre, j'ouvre une nouvelle macro, je copie/colle la macro en remplaçant A65366 par D2, je fais "play" et rien ne se passe …

Il ne faut pas remplacer A65366 par D2 ; mais par D65366

Avec tes données en colonne D , macro :

Sub ExtractionTitre()
    For lig = 2 To ActiveSheet.Range("D65536").End(xlUp).Row
        Txt = Cells(lig, 4)
        For k = 1 To Len(Txt)
            If Mid(Txt, k, 1) <> " " And Mid(Txt, k, 1) = LCase(Mid(Txt, k, 1)) And IsNumeric(Mid(Txt, k, 1)) = False Then Exit For
        Next
        Cells(lig, 5) = Left(Txt, k - 2)
        Txt = Mid(Txt, k - 1, Len(Txt))
        For k = 1 To Len(Txt)
            If IsNumeric(Mid(Txt, k, 1)) Then Exit For
        Next
    Next
End Sub

A +

Ça marche ! Je ne sais pas pourquoi maintenant et pas avant mais c'est nickel !

Merci à tous pour votre patience, vous m'avez retiré une sacrée épine du pied…

Vous êtes formidables ! ;)

Lionel

Super

On est là pour essayer d'aider, c'est normal

Bonne soirée

Bonsoir à tous !

Bien....

Je vous remercie de ce retour.

re,

je ne sais pas la ligne où vous avez cette erreur avec ma macro

19diabolyo.xlsb (23.12 Ko)
Rechercher des sujets similaires à "extraire texte majuscule"