XL 2013 supprimer les lignes contenant un mot

[belhoucine dine]

Bonne soirée à vous tous

je veux un code VBA pour supprimer les lignes contenant le mot (EXPIRE) dans la colonne H

Je vous envoie le fichier pour plus de précisions
Merci pour votre aide.

 

[sylvanu]

Bonsoir belhoucine dine,
Un essai en PJ avec :

Sub SupLigExpire()
    Application.ScreenUpdating = False
    ActiveSheet.ListObjects(1).Name = "Tablo"               ' On s'afranchit du nom du tableau en le renommant
    For L = [tablo].ListObject.ListRows.Count To 1 Step -1  ' Pour chaque ligne
        If [tablo].Item(L, 8) = "EXPIRE" Then [tablo].Item(L, 8).Delete xlUp ' On supprime la ligne si EXPIRE
    Next L
End Sub

 

[job75]

Bonsoir,

Sur un grand tableau ceci est plus rapide je pense mais ce sera à tester :

Sub SupprimeEXPIRE()
With ListObjects(1).Range
    .Sort .Columns(8), xlAscending, Header:=xlYes 'tri pour regrouper et accélérer
    On Error Resume Next 'si aucune SpecialCell
    .Columns(8).SpecialCells(xlCellTypeFormulas, 2).Delete xlUp
End With
End Sub

Edit : la macro est dans le code de la feuille sinon écrire ActiveSheet.ListObjects(1).Range

A+

 

[job75]

Donc pour tester j'ai recopié le tableau sur (seulement) 8200 lignes.

La macro du post #2 s'exécute chez moi en 61 secondes.

Celle du post #3 s'exécute en 0,14 seconde.

 

[sylvanu]

Bonsoir Job,
Par contre cela mélange les lignes restantes qui sont triées par ordre croissant sur la colonne H.
A voir si cela n'a pas d'impact pour le demandeur.

 

[job75]

On peut mémoriser l'ordre du classement initial et le restituer à la fin :

Sub SupprimeEXPIRE()
Application.ScreenUpdating = False
With ListObjects(1).Range
    .Columns(8).Insert xlToRight 'insère une colonne auxiliaire
    .Columns(8) = "=ROW()": .Columns(8) = .Columns(8).Value 'numérotation
    .Sort .Columns(9), xlAscending, Header:=xlYes 'tri pour regrouper et accélérer
    On Error Resume Next 'si aucune SpecialCell
    .Columns(9).SpecialCells(xlCellTypeFormulas, 2).Delete xlUp
    .Sort .Columns(8), xlAscending, Header:=xlYes 'tri dans l'ordre initial
    .Columns(8).Delete xlToLeft 'supprime la colonne auxiliaire
End With
End Sub

La durée d'exécution est un peu augmentée : 0,19 seconde sur 8200 lignes.

 

[sylvanu]

Bonjour Job,
Dans ce cas on peut encore accélérer en utilisant ce code, cela évite le second tri :

Sub SupprimeEXPIRE()
Application.ScreenUpdating = False
ActiveSheet.ListObjects(1).Name = "Tablo"
With ListObjects(1).Range
    .Columns(8).Insert xlToRight 'insère une colonne auxiliaire
    .Columns(8).FormulaLocal = "=SI(Tablo[[#Cette ligne];[Colonne1]]=""EXPIRE"";"""";1)": .Columns(8) = .Columns(8).Value ' 1 si non expiré
    .Sort .Columns(8), xlDescending, Header:=xlYes 'tri pour regrouper et accélérer
    On Error Resume Next 'si aucune SpecialCell
    .Columns(8).SpecialCells(xlCellTypeBlanks, 2).Delete xlUp
    .Columns(8).Delete xlToLeft 'supprime la colonne auxiliaire
End With
End Sub

 

[job75]

Bonjour sylvanu, le forum,

En effet mais on peut utiliser une formule très simple :

Sub SupprimeEXPIRE()
Application.ScreenUpdating = False
With ListObjects(1).Range
    .Columns(8).Insert xlToRight 'insère une colonne auxiliaire
    .Columns(8) = "=1/ISNUMBER(RC[1])": .Columns(8) = .Columns(8).Value
    .Sort .Columns(8), xlAscending, Header:=xlYes 'tri pour regrouper et accélérer
    On Error Resume Next 'si aucune SpecialCell
    .Columns(8).SpecialCells(xlCellTypeConstants, 16).Delete xlUp
    .Columns(8).Delete xlToLeft 'supprime la colonne auxiliaire
End With
End Sub

A+

 

[sylvanu]

Re Job,
Encore plus rapide puisqu'il n'y a ni insertion de colonne, ni formules.
On filtre sur "EXPIRE" et on supprime les lignes visibles :

Sub SupprimeEXPIRE()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With ActiveSheet
    .ListObjects(1).Name = "Tablo"
    If .AutoFilterMode Then .AutoFilterMode = False
    .ListObjects("Tablo").Range.AutoFilter Field:=8, Criteria1:="EXPIRE"
    .Range("Tablo").SpecialCells(xlCellTypeVisible).Delete
    .ListObjects("Tablo").Range.AutoFilter Field:=8
End With
Application.DisplayAlerts = True
End Sub

 

[job75]

Non sans tri c'est beaucoup moins rapide, sur 8200 lignes => 1,9 seconde.

 

[belhoucine dine]

Bonjour tout le monde
Merci beaucoup à vous tous de m'avoir aidé, tout votre travail est bon et m'a beaucoup aidé.
Mon problème a été résolu
Merci