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

JDDubuc

XLDnaute Nouveau
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

XLDnaute Barbatruc
Repose en paix
Re,

Puisque vous n'avez pas donné d'exemple, voyez dans le fichier joint la macro :
VB:
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
 

Pièces jointes

  • test filtre.xlsm
    19.2 KB · Affichages: 18

job75

XLDnaute Barbatruc
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

XLDnaute Barbatruc
Fichier joint (merci Roblochon) avec cette macro :
VB:
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
 

Pièces jointes

  • test filtre(1).xlsm
    27.3 KB · Affichages: 5

job75

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

Si l'on veut conserver les formats utiliser :
VB:
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+
 

Pièces jointes

  • test filtre(2).xlsm
    27.9 KB · Affichages: 2

Discussions similaires

Statistiques des forums

Discussions
314 611
Messages
2 111 145
Membres
111 051
dernier inscrit
MANUREVALAND