Supprimer ligne mot entièrement en majuscule

Le 10/11/2019 à 19:25

Bonjour,

j'ai cherché sut le forum une réponse à mon problème. J'ai trouvé un fichier mais je n'arrive pas à l'utiliser pour mon problème. Je mets en pièce jointe un extrait de mon classeur (classeru2) et le fichier que j'ai trouvé sur votre forum (test 24)

Mon problème est le suivant :

J'ai dans la colonne A des cellules avec parfois un mot entièrement en majuscule, parfois un prénom, parfois deux-trois prénoms...

Je voudrais supprimer les cellules qui contiennent des mots entièrement en majuscule, par exemple la cellule A4.

Quelqu'un pourrait-il m'aider ?

Un grand merci.

6classeur2.xlsx (8.87 Ko)
2test24-1.xlsm (59.28 Ko)
Le 10/11/2019 à 19:33

Bonsoir Cedric, bonsoir le forum,

Et si il y a plusieurs mots dans la même cellule dont 1 tout en majuscule, ça compte ou pas ? Ou faut-il que tous les mots soient en majuscule pour supprimer la ligne ?

Le 10/11/2019 à 19:45

Merci pour cette aide rapide.

Je viens de vérifier mon fichier d'origine, ce problème ne se pose pas. Les cellules que je souhaite supprimer contiennent uniquement un ou 2 mots entièrement en majuscule.

Toutes les autres cellules que je souhaite garder contiennent des mots (prénoms) avec uniquement la première lettre en majuscule. L'exemple du classeur que j'ai mis en pièce est le reflet de mon fichier.

Le 10/11/2019 à 20:35

Re,

CE petit bout de code n'est pas fiable à 100 %. Notamment s'il existe des majuscules accentuées... À tester :

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Taleau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim C As String 'déclare la variable C (Caractère)
Dim TEST As Boolean 'déclare la variable TEST

Set O = Worksheets("Feuil1") 'définit l'onglet O
TV = O.Range("A1").CurrentRegion 'définit la tableau des valeurs TV
For I = UBound(TV, 1) To 1 Step -1 'boucle inversée sur toutes les lignes I du tableau des valeurs de la dernière à la première
    TEST = False 'initialise la variable TEST
    Trim (TV(I, 1)) 'suprime les éventuels espaces avant et après la donnée ligne I colonne 1 de TV
    TV(I, 1) = Replace(TV(I, 1), " ", "", 1, 1, vbTextCompare) 'supprime les éventuels espaces à l'intérieur (si plusieurs mots)
    TV(I, 1) = Replace(TV(I, 1), Chr(10), "", 1, 1, vbTextCompare) 'supprime les éventuels retour à la ligne
    TV(I, 1) = Replace(TV(I, 1), Chr(13), "", 1, 1, vbTextCompare) 'supprime les éventuels retour de chariot
    For J = 1 To Len(TV(I, 1)) 'boucle sur tous les caractères de la donnée épurée
        C = Mid(TV(I, 1), J, 1) 'définit le caractère C de la boucle
        If Asc(C) < 65 Or Asc(C) > 90 Then TEST = True: Exit For 'si C n'est pas une majuscule TEST est [Vrai]
    Next J 'prochaoin caractère de la boucle 2
    If TEST = False Then O.Rows(I).Delete 'si TEST est [Faux] (= que des majuscules), supprime la ligne I de la boucle
Next I 'prochaine ligne de la boucle (en remontant)
End Sub
Le 10/11/2019 à 20:44

Un Immense merci

C'est très bien. Effectivement, les majuscules accentuées et les noms composés avec un trait d'union ne fonctionnent pas. Masi c'est pas bien grave. Un contrôle visuel et je les supprimerai à la main...

Encore merci.

Le 11/11/2019 à 11:19

Re,

Pour les traits d'union le code ci-dessous. On pourrait aussi imaginer tous les cas d'accents et les remplacer par leur lettre sans accent avec la même méthode, mais je t'avoue que j'ai eu la flemme...

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Taleau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim C As String 'déclare la variable C (Caractère)
Dim TEST As Boolean 'déclare la variable TEST

Set O = Worksheets("Feuil1") 'définit l'onglet O
TV = O.Range("A1").CurrentRegion 'définit la tableau des valeurs TV
For I = UBound(TV, 1) To 1 Step -1 'boucle inversée sur toutes les lignes I du tableau des valeurs de la dernière à la première
    TEST = False 'initialise la variable TEST
    Trim (TV(I, 1)) 'suprime les éventuels espaces avant et après la donnée ligne I colonne 1 de TV
    TV(I, 1) = Replace(TV(I, 1), " ", "", 1, 1, vbTextCompare) 'supprime les éventuels espaces à l'intérieur (si plusieurs mots)
    TV(I, 1) = Replace(TV(I, 1), Chr(10), "", 1, 1, vbTextCompare) 'supprime les éventuels retour à la ligne
    TV(I, 1) = Replace(TV(I, 1), Chr(13), "", 1, 1, vbTextCompare) 'supprime les éventuels retour de chariot
    TV(I, 1) = Replace(TV(I, 1), "-", "", 1, 1, vbTextCompare) 'supprime les éventuels traits d'union
    For J = 1 To Len(TV(I, 1)) 'boucle sur tous les caractères de la donnée épurée
        C = Mid(TV(I, 1), J, 1) 'définit le caractère C de la boucle
        If Asc(C) < 65 Or Asc(C) > 90 Then TEST = True: Exit For 'si C n'est pas une majuscule TEST est [Vrai]
    Next J 'prochaoin caractère de la boucle 2
    If TEST = False Then O.Rows(I).Delete 'si TEST est [Faux] (= que des majuscules), supprime la ligne I de la boucle
Next I 'prochaine ligne de la boucle (en remontant)
End Sub
Le 11/11/2019 à 12:38

Encore merci !

je vais l'essayer.

Rechercher des sujets similaires à "supprimer ligne mot entierement majuscule"