Comment faire pour supprimer des lignes dans Excel basé sur des critères à l'aide de VBA?

Je suis actuellement à la construction d'une macro pour formater une feuille de données, ainsi qu'à supprimer inapplicable lignes de données. Plus précisément, je suis à la recherche de supprimer des lignes où la Colonne L = "ABC", ainsi que de supprimer les lignes où la Colonne AA <> "DEF".

Jusqu'à présent j'ai été en mesure d'atteindre le premier objectif, mais pas la seconde. Le code actuel est:

Dim LastRow As Integer
Dim x, y, z As Integer
Dim StartRow, StopRow As Integer

For x = 0 To LastRow
    If (Range("L1").Offset(x, 0) = "ABC") Then
    Range("L1").Offset(x, 0).EntireRow.Delete
    x = x - 1

End If

OriginalL'auteur Laura Kane-Punyon | 2011-10-04

Il est normalement beaucoup plus rapide à utiliser de filtre automatique plutôt que la boucle des Plages

Le code ci-dessous crée un travail de colonne, puis utiliser une formule pour détecter supprimer des critères, puis de filtre automatique et supprimer le résultat des enregistrements

Le travail de la colonne met une formule

=OR(L1="ABC",AA1<>"DEF")
dans la ligne 1 de la première colonne vide, puis copie le bas aussi loin ar la vrai plage utilisée. Puis tout VRAI enregistrements sont quicklly supprimé avec filtre automatique

Sub QuickKill()
    Dim rng1 As Range, rng2 As Range, rng3 As Range
    Set rng1 = Cells.Find("*", , xlValues, , xlByColumns, xlPrevious)
    Set rng2 = Cells.Find("*", , xlValues, , xlByRows, xlPrevious)
    Set rng3 = Range(Cells(rng2.Row, rng1.Column), Cells(1, rng1.Column))
    Application.ScreenUpdating = False
    Rows(1).Insert
    With rng3.Offset(-1, 1).Resize(rng3.Rows.Count + 1, 1)
        .FormulaR1C1 = "=OR(RC12=""ABC"",RC27<>""DEF"")"
        .AutoFilter Field:=1, Criteria1:="TRUE"
        .EntireRow.Delete
        On Error Resume Next
        'in case all rows have been deleted
        .EntireColumn.Delete
        On Error GoTo 0
    End With
    Application.ScreenUpdating = True
End Sub

pourquoi est-filtre automatique plus rapide?

OriginalL'auteur brettdj

À l'aide d'un boucle:

Sub test()
    Dim x As Long, lastrow As Long
    lastrow = Cells(Rows.Count, 1).End(xlUp).Row
    For x = lastrow To 1 Step -1
        If Cells(x, 12).Value = "ABC" or Cells(x, 27) <> "DEF" Then
            Rows(x).Delete
        End If
    Next x
End Sub

À l'aide de filtre automatique (non testé - probablement plus rapide):

Sub test2()
    Range("a1").AutoFilter Field:=12, Criteria1:="ABC", Operator:=xlOr, _
                           Field:=28, Criteria1:="<>""DEF"""
    'exclude 1st row (titles)
    With Intersect(Range("a1").CurrentRegion, _
                   Range("2:60000")).SpecialCells(xlCellTypeVisible)
        .Rows.Delete
    End With
    ActiveSheet.ShowAllData
End Sub

+1 pour la direction, mais où est-DEF 🙂 ?
édité. Thx !
Ouais mais, AA <> "DEF". 🙂
Oups, va trop vite (je dois, si je veux répondre avant de le faire :))
Si vous ne souhaitez pas supprimer la première ligne (si vous en avez un en-tête), le changement For x = lastRow To 1 Step -1 à For x = lastRow To 2 Step -1

OriginalL'auteur Patrick Honorez

Cellule avec le numéro 12 est "L" et le numéro 27 est "AA"

Dim x As Integer

x = 1

Do While x <= ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row

    If (Cells(x, 12) = "ABC") Then
    ActiveSheet.Rows(x).Delete
    Else
        If (Cells(x, 27) <> "DEF") And (Cells(x, 27) <> "") Then
        ActiveSheet.Rows(x).Delete
        Else
        x = x + 1
        End If
    End If

Loop

End Sub

OriginalL'auteur Metaller

Sub test()

    Dim bUnion As Boolean
    Dim i As Long, lastrow As Long
    Dim r1 As Range
    Dim v1 As Variant

    lastrow = Cells(Rows.Count, 1).End(xlUp).Row
    v1 = ActiveSheet.Range(Cells(1, 12), Cells(lastrow, 27)).Value2
    bUnion = False

    For i = 1 To lastrow
        If v1(i, 1) = "ABC" Or v1(i, 16) <> "DEF" Then
            If bUnion Then
                Set r1 = Union(r1, Cells(i, 1))
            Else
                Set r1 = Cells(i, 1)
                bUnion = True
            End If
        End If
    Next i
    r1.EntireRow.Delete

End Sub

OriginalL'auteur Jon49

Vous devez vous connecter pour publier un commentaire.