How to delete rows in Excel based on criteria using VBA?

前端 未结 4 746
花落未央
花落未央 2020-11-29 12:35

I am currently building a macro to format a sheet of data as well as to remove inapplicable rows of data. Specifically, I am looking to delete rows where Column L = \"ABC\"

相关标签:
4条回答
  • 2020-11-29 12:39

    It is normally much quicker to use AutoFilter rather than loop Ranges

    The code below creates a working column, then use a formula to detect delete criteria and then autofilter and delete the result records

    The working column puts a formula

    =OR(L1="ABC",AA1<>"DEF") into row 1 of the first blank column then copies down as far ar the true used range. Then any TRUE records are quicklly deleted with AutoFilter

    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
    
    0 讨论(0)
  • 2020-11-29 12:54
    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
    
    0 讨论(0)
  • 2020-11-29 12:59

    Cell with number 12 is "L" and number 27 is "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
    
    0 讨论(0)
  • 2020-11-29 13:00

    Using a loop:

    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
    

    Using autofilter (untested - probably faster):

    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
    
    0 讨论(0)
提交回复
热议问题