XL 2019 Suppression de ligne si un mot ou partie de mot est dans les cellules

[JDDubuc]

Je voudrais supprimer les lignes dont les cellules d'une colonne ( a l 'ocurance la c' est O) contient "COMPTE", quand j' execute la macro suivant ca m'efface toutes les lignes. est ce que l'on peut me dire ou est l'erreur
Sub Macro1()
Dim PLG_FIL As Range
If Not ActiveSheet.AutoFilterMode Then
Range("O1").AutoFilter Field:=1, Criteria1:="compte"
End If
Set PLG_FIL = ActiveSheet.AutoFilter.Range
PLG_FIL.Offset(1, 0).Resize(PLG_FIL.Rows.Count - 1, 1).EntireRow.Delete
ActiveSheet.AutoFilterMode = False
End Sub
Merci pour l'aide

 

[Hasco]

Bonjour,

L'erreur déjà est de ne pas dire bonjour. Je passe mon chemin;

 

[JDDubuc]

vous avez raison avec toute mes excuses

 

[Hasco]

Re,

Puisque vous n'avez pas donné d'exemple, voyez dans le fichier joint la macro :

Sub SupprimerLignesCompte()
    Dim PLG_To_Delete As Range
    Dim Valeurs As Variant
    Dim i As Long
    With ActiveSheet
       ' Tableaux vb des valeurs de la colonne qui contient des 'comptes'
        Valeurs = .Range("A1").CurrentRegion.Columns(2)
        '
        ' Parcourir les valeurs à partir de 2 (1 = valeur de l'étiquette d'entête de colonne)
        For i = 2 To UBound(Valeurs)
            '
            ' Si compte
            If Valeurs(i, 1) = "compte" Then
                '
                ' Créer éventuellement une première plage à unir ultérieurement
                ' sinon la méthode Union lèverait une erreur
                If PLG_To_Delete Is Nothing Then
                    Set PLG_To_Delete = .Cells(i, 1)
                Else
                    Set PLG_To_Delete = Union(PLG_To_Delete, .Cells(i, 1))
                End If
            End If
        Next
        '
        ' si on a obtenu une plage à supprimer alors BOUM!
        If Not PLG_To_Delete Is Nothing Then PLG_To_Delete.EntireRow.Delete
    End With
End Sub

Cette méthode est plus simple à utiliser que celle du filtrage automatique.
Avec le filtrage automatique, il faut utiliser SpecialCells(xlCellTypeVisible) qui peut renvoyer une erreur s'il n'y a pas de correspondance.
S'il y en a pour ne pas supprimer l'entête de tableau, il faut parcourir chaque 'Aire' de la plage trouvée et voir si la première ligne de l'aire n'est pas la ligne 1 du tableau, pour ensuite reconstruire une plage à supprimer.

Tâchez de joindre un fichier exemple dans vos futures discussions. Chaque cas étant particulier et les risques de se tromper tellement nombreux...

Cordialement

 

[JDDubuc]

Merci pour votre aide , je vais essayer

 

[job75]

Bonjour JDDubuc, Roblochon,

Il faut savoir que la suppression avec Union pédale dans la choucroute s'il y a plusieurs milliers de lignes disjointes à supprimer.

Tout comme la suppression par filtrage d'ailleurs.

La meilleure solution est d'utiliser des tableaux VBA.

A+

 

[job75]

Fichier joint (merci Roblochon) avec cette macro :

Sub SupprimerLignesCompte()
Dim critere$, colcrit%, ncol%, tablo, i&, n&, j%
critere = "*compte*" 'avec caractère générique et en minuscules
colcrit = 2 'n° de la colonne à tester, à adapter
With Feuil1 'CodeName de la feuille BDD, à adapter
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .[A1].CurrentRegion 'adapter au besoin
        ncol = .Columns.Count
        If ncol = 1 Then ncol = 2 'au moins 2 cellules
        If ncol < colcrit Then ncol = colcrit
        tablo = .Resize(, ncol) 'matrice, plus rapide
        For i = 1 To UBound(tablo)
            If Not LCase(tablo(i, colcrit)) Like critere Then
                n = n + 1
                For j = 1 To ncol
                    tablo(n, j) = tablo(i, j)
                Next j
            End If
        Next i
        If n Then .Resize(n, ncol) = tablo
        .Offset(n).Resize(.Parent.Rows.Count - n - .Row + 1, ncol).ClearContents 'RAZ en dessous
    End With
End With
End Sub

 

[JDDubuc]

Bonjour
Merci pour l'aide tout fonctionne pour moi avec votre premiere macro que j'ai légèrement modifiée pour mes fichiers

 

[job75]

La solution précédente copie uniquement les valeurs.

Si l'on veut conserver les formats utiliser :

Sub SupprimerLignesCompte()
Dim critere$, colcrit%, ncol%, tablo, i&, n&, j%
critere = "compte"
colcrit = 2 'n° de la colonne à tester, à adapter
Application.ScreenUpdating = False
With Feuil1 'CodeName de la feuille BDD, à adapter
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .UsedRange 'adapter au besoin
        ncol = .Columns.Count
        .Columns(ncol + 1).EntireColumn.Insert 'colonne auxiliaire
        .Columns(ncol + 1).FormulaR1C1 = "=1/ISERR(SEARCH(""" & critere & """,RC" & colcrit & "))"
        .Columns(ncol + 1) = .Columns(ncol + 1).Value 'supprime les formules
        .EntireRow.Sort .Columns(ncol + 1), xlAscending, Header:=xlNo 'tri pour grouper et accélérer
        On Error Resume Next 'si aucune SpecialCell
        .Columns(ncol + 1).SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete 'supprime les valeurs d'erreur
        .Columns(ncol + 1).EntireColumn.Delete 'supprime la colonne auxiliaire
    End With
End With
End Sub

Fichier (2), grâce au tri l'exécution est très rapide.

A+

 

[job75]

Pour tester j'ai recopié la plage A2:B19 sur 180 000 lignes, chez moi sur Win 10 - Excel 2013 :

- fichier (1) => 0,71 seconde

- fichier (2) => 1,51 seconde.