Suppression de lignes sous conditions

[fouggy]

Slt à tous,

Ma problématique du jour est la suivante :

Dans un classeur ouvert comportant plus de mille onglets (!!!), il s'agit de supprimer, dans chaque onglet, toutes les lignes dont les informations ne servent à rien.

Bien évidemment, d'un onglet à l'autre, les informations à conserver, ne se trouvent pas positionnées forcément sur les mêmes lignes. (Si c'était le cas j'aurais pu créer la macro tout seul, mais ce n'est pas le cas malheureusement et le pb dépasse mon niveau actuel -).

Dans chaque onglet, les lignes à conserver sont identifiables par les cellules de la colonne A.

* La 1re ligne à conserver contient toujours dans une cellule de la colonne A un certain nombre de caractères dont le 1er est "R" (suivi d'autres caractères qui peuvent être différents).
* La 2me ligne à conserver comporte les mêmes caractéristiques (cellule de la colonne A commençant aussi par "R".
* Les autres lignes à conserver constituent une suite de cellules de la colonne A dont la configuration est toujours la même : Une 1re cellule comportant le caractère "N°", suivie d'une cellule vide, suivie de plusieurs cellules comportant des chiffres de 1 à 25 maximum, suivies d'une cellule vide.

La macro consisterait donc à dire :
* Supprime toutes les lignes se trouvant avant celle dont la 1re cellule rencontrée de la colonne A comporte des caractères dont le 1er est "R", puis,
* Supprime toutes les lignes se trouvant entre la ligne conservée (précédente) et la suivante ayant les mêmes caractéristiques.
* Supprime toutes les lignes se trouvant entre la dernière ligne conservée (précédente) et la ligne dont la 1re cellule de la colonne A est "N°"
* Supprime enfin toutes les lignes (jusqu'à la fin de l'onglet) se trouvant après celles dont les cellules de la colonne A comportent un chiffre.

Voilà donc. Plus difficile à expliquer qu'à comprendre, lol. En fichier joint 2 exemples avec résultats attendus.

Pour celles ou ceux qui prendraient le temps de me répondre, merci de bien vouloir intégrer des commentaires (en vert), afin que je puisse, comprendre et intégrer à ma formation actuelle.

Un grand merci d'avance

 

[Robert]

Re : Suppression de lignes sous conditions

Bonsoir Fouggy, bonsoir le forum,

Peut-être comme ça :

Sub Macro2()
Dim O As Object 'déclare la variable O (Onglets)
Dim PL As Range 'déclare la variable PL (PLage)
Dim R As Range 'déclare la variable R (Recherche)
Dim PA As String 'déclare la variable PA (Première Adresse)
Dim LD As Integer 'déclare la variable LD (Ligne de Début)
Dim CEL As Range 'déclare la variable CEL (CELlule)
Dim LF As Integer 'déclare la variable LF (Ligne de Fin)
Dim LI As Integer 'déclare la variable LI (LIgne)
Dim LAG As Range 'déclare la variable LAG (Lignes A Garder)

For Each O In Sheets 'boucle sur tous les onglets O du classeur
    Set PL = Application.Intersect(O.UsedRange, O.Columns(1)) 'définit la plage PL
    'supprime les éventuelles lignes vides au-dessus de la première ligne de la plage PL
    If PL(1).Row > 1 Then O.Rows("1:" & PL(1).Row - 1).Delete
    Set PL = Application.Intersect(O.UsedRange, O.Columns(1)) 'redéfinit la plage PL
    Set R = PL.Find("N°", , xlValues, xlWhole) 'définit la recherche R (Rechercne "N°" dans la plage PL)
    Set LAG = O.Range("A1") 'initialise la plage LAG
    If Not R Is Nothing Then 'condition : si il existe au moins une occurrence trouvée
        PA = R.Address 'définit l'adresse de la première occurrence trouvée
        Do 'exécute
            LD = R.Row 'définit la ligne du début LD
            Set CEL = R.End(xlDown) 'atteint le premier numéro de la série
            Set CEL = CEL.End(xlDown) 'atteint le dernier numéro de la série
            LF = CEL.Row 'définit la ligne de fin LF
            'definit la plage LAG : si LAG ne contient qu'une seule cellule, LAG devient la plage des lignes LD à LF,
            'sinon, LAG devient l'union de LAG et de la plage des lignes LD à LF (au cas où il y aurait plusieur N°)
            Set LAG = IIf(LAG.Cells.Count = 1, O.Rows(LD & ":" & LF), Application.Union(LAG, O.Rows(LD & ":" & LF)))
            Set R = PL.FindNext(R) 'redéfinit la recherche (occurrence suivante)
        Loop While Not R Is Nothing And R.Address <> PA 'boucle tant qu'il existe des occurrences ailleirs qu'en PA
    End If 'fin de la condition
    'boucle inversée : de la dernière ligne éditée de la colnne 1 (=A) à la ligne 1 en remontant d'une ligne
    For LI = O.Cells(Application.Rows.Count, 1).End(xlUp).Row To 1 Step -1
        'condition : si la cellule de la ligne Li , colonne 1 (=A) ne fait pas partie de la plage LAG
        If Application.Intersect(O.Cells(LI, 1), LAG) Is Nothing Then
            'si le premier caractère de la cellule n'est pas un "R", supprim,e la ligne
            If Left(O.Cells(LI, 1).Value, 1) <> "R" Then O.Rows(LI).Delete
        End If 'fin de la condition
    Next LI 'prochaine ligne de la boucle
Next O 'prochain onglet du classeur
End Sub

 

[mapomme]

Re : Suppression de lignes sous conditions

Bonsoir fouggy, Robert ,

Une version au code beaucoup plus long que celui de Robert. Mais j'avais commencé...

 

[fouggy]

Re : Suppression de lignes sous conditions

Bonjour à tous les 2 et merci de votre contribution.
La complexité, qui me dépasse, de la macro fait que je n'arrive pas à voir dans celle de Robert où cela pêche pour ne pas arriver au résultat attendu. En revanche celle de Mapomme fonctionne au top.

Elles sont toutes les 2, deux approches différentes que j'analyserais au fil de ma progression en matière de macro.

Un grand merci encore.

 

[Robert]

Re : Suppression de lignes sous conditions

Bonjour le fil, bonjour le forum,

Comme quoi Mapomme, ce n'est pas le code le plus court qui est le meilleur...
Comme j'y ai passé pas mal de temps, je suis assez frustré de lire qu'il ne fonctionne pas. Chez moi il fonctionne sur les deux misérables exemples que tu as daigné fournir. Mais, j'ai oublié de préciser, j'ai dû modifier 3 données commençant par "R" car il y avait un espace devant " R" au lieu de "R" et du coup, comme le code réagit au premier caractère de la cellule, quand il y a un espace devant ça ne fonctionne plus... Je l'ai donc supprimé.
Néanmois, un bon conseil, prend celle qui fonctionne au top et ne t'emm...de pas avec celle qui ne fonctionne pas.