Excel VBA 各种删除方法

Eddy Xu 2019/8/23 excel vba

Note: Code belong to this webpage. Ron de Bruin Excel Automation

Loop backwards through all rows and use Union

This example will loop through all rows in the usedrange and use Union to make a range (rng) with all cells with the value "ron". Then it delete the rows in one time with rng.EntireRow.delete, this will be faster then deleting in the loop like we do in the example on the webpage

Note: you can use a lot of tips/examples from the example on the webpage in this union example. Note: There is a maximum of 8192 separate areas when you use Union in Excel 97-2007.

Code example

The code below will delete every row in the usedrange with "ron" in the A column. If .Value = "ron" Then .EntireRow.Delete

I use the A column in my example, change the A to your column in this code line. With .Cells(Lrow, "A")

Sub Union_Example()
   Dim Firstrow As Long
   Dim Lastrow As Long
   Dim Lrow As Long
   Dim CalcMode As Long
   Dim ViewMode As Long
   Dim rng As Range

   With Application
       CalcMode = .Calculation
       .Calculation = xlCalculationManual
       .ScreenUpdating = False
   End With

   'We use the ActiveSheet but you can replace this with
   'Sheets("MySheet")if you want
   With ActiveSheet

       'We select the sheet so we can change the window view
       .Select

       'If you are in Page Break Preview Or Page Layout view go
       'back to normal view, we do this for speed
       ViewMode = ActiveWindow.View
       ActiveWindow.View = xlNormalView

       'Turn off Page Breaks, we do this for speed
       .DisplayPageBreaks = False

       'Set the first and last row to loop through
       Firstrow = .UsedRange.Cells(1).Row
       Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row

       'We loop from Lastrow to Firstrow (bottom to top)
       For Lrow = Lastrow To Firstrow Step -1

           'We check the values in the A column in this example
           With .Cells(Lrow, "A")

               If Not IsError(.Value) Then

                   If .Value = "ron" Then
                       'This will delete each row with the Value "ron"
                       'in Column A, case sensitive.

                       If rng Is Nothing Then
                           Set rng = .Cells
                       Else
                           Set rng = Application.Union(rng, .Cells)
                       End If
                   End If

               End If
           End With

       Next Lrow

   End With

   'Delete all rows in one time
   If Not rng Is Nothing Then rng.EntireRow.Delete

   ActiveWindow.View = ViewMode
   With Application
       .ScreenUpdating = True
       .Calculation = CalcMode
   End With

End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69

Use AutoFilter to delete rows

with AutoFilter you can also use wildcards.

"ron" End with ron "ron" Start with ron "ron" ron is a part of the string

You can also use the wildcard ? for a single character.

Note: in the examples I use the range .Range("A1:A" & .Rows.Count) Remember that A1 of this range is your header cell.

One criteria

The example below filter A1:A? on the ActiveSheet for the DeleteValue and delete the rows.

Sub Delete_with_Autofilter()
    Dim DeleteValue As String
    Dim rng As Range
    Dim calcmode As Long

    With Application
        calcmode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    'Fill in the value that you want to delete
    'Tip: use DeleteValue = "<>ron" to delete rows without ron
    DeleteValue = "ron"

    'Sheet with the data, you can also use Sheets("MySheet")
    With ActiveSheet

        'Firstly, remove the AutoFilter
        .AutoFilterMode = False

        'Apply the filter
        .Range("A1:A" & .Rows.Count).AutoFilter Field:=1, Criteria1:=DeleteValue

        With .AutoFilter.Range
            On Error Resume Next
            Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
                      .SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
            If Not rng Is Nothing Then rng.EntireRow.Delete
        End With

        'Remove the AutoFilter
        .AutoFilterMode = False
    End With

    With Application
        .ScreenUpdating = True
        .Calculation = calcmode
    End With

End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42

Two criteria

The example below filter A1:A? on the ActiveSheet for the DeleteValue1 and 2 and delete the rows.

Sub Delete_with_Autofilter_Two_Criteria()
    Dim DeleteValue1 As String
    Dim DeleteValue2 As String
    Dim rng As Range
    Dim calcmode As Long

    With Application
        calcmode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    'Fill in the two values that you want to delete
    DeleteValue1 = "ron"
    DeleteValue2 = "jelle"

    'Sheet with the data, you can also use Sheets("MySheet")
    With ActiveSheet

        'Firstly, remove the AutoFilter
        .AutoFilterMode = False

        'Apply the filter
        .Range("A1:A" & .Rows.Count).AutoFilter Field:=1, _
        Criteria1:=DeleteValue1, Operator:=xlOr, Criteria2:=DeleteValue2

        With .AutoFilter.Range
            On Error Resume Next
            Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
                      .SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
            If Not rng Is Nothing Then rng.EntireRow.Delete
        End With

        'Remove the AutoFilter
        .AutoFilterMode = False
    End With

    With Application
        .ScreenUpdating = True
        .Calculation = calcmode
    End With

End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44

Example to filter between two dates, you not use the DeleteValue1 and 2 string then. This will delete all records in 2006. (Note: I use xlAnd here). You can use this also if you want to filter numeric values.

.AutoFilter Field:=1, Criteria1:=">=" & DateSerial(2006, 1, 1), _ Operator:=xlAnd, Criteria2:="<" & DateSerial(2007, 1, 1) ' yyyy-mm-dd format

More then two Criteria

For more then two Criteria you can loop through the words in the array. Note: This is also working if you use one word in the array.

Sub Delete_with_Autofilter_Array()
    Dim rng As Range
    Dim calcmode As Long
    Dim myArr As Variant
    Dim I As Long

    With Application
        calcmode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    'Fill in the values that you want to delete
    myArr = Array("ron", "Dave", "Jelle")

    For I = LBound(myArr) To UBound(myArr)

        'Sheet with the data, you can also use Sheets("MySheet")
        With ActiveSheet

            'Firstly, remove the AutoFilter
            .AutoFilterMode = False

            'Apply the filter
            .Range("A1:A" & .Rows.Count).AutoFilter Field:=1, Criteria1:=myArr(I)

            Set rng = Nothing
            With .AutoFilter.Range
                On Error Resume Next
                Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
                          .SpecialCells(xlCellTypeVisible)
                On Error GoTo 0
                If Not rng Is Nothing Then rng.EntireRow.Delete
            End With

            'Remove the AutoFilter
            .AutoFilterMode = False
        End With

    Next I

    With Application
        .ScreenUpdating = True
        .Calculation = calcmode
    End With

End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47

Criteria range on a different sheet*

Example with the criteria range on a different sheet

The example below filter A1:A? In a sheet named “data”. And use as criteria all the cells in column A of a sheet named “Criteria”. Note: You can use also wildcards like food or *store if you want.

Sub Delete_with_Autofilter_More_Criteria()
    Dim rng As Range
    Dim cell As Range
    Dim CriteriaRng As Range
    Dim calcmode As Long

    With Application
        calcmode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    With Sheets("Criteria")
        Set CriteriaRng = .Range("A1", .Cells(Rows.Count, "A").End(xlUp))
    End With

    'Loop through the cells in the Criteria range
    For Each cell In CriteriaRng

        With Sheets("data")

            'Firstly, remove the AutoFilter
            .AutoFilterMode = False

            'Apply the filter
            .Range("A1:A" & .Rows.Count).AutoFilter Field:=1, Criteria1:=cell.Value

            With .AutoFilter.Range
                Set rng = Nothing
                On Error Resume Next
                Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
                          .SpecialCells(xlCellTypeVisible)
                On Error GoTo 0
                If Not rng Is Nothing Then rng.EntireRow.Delete
            End With

            'Remove the AutoFilter
            .AutoFilterMode = False
        End With

    Next cell

    With Application
        .ScreenUpdating = True
        .Calculation = calcmode
    End With
    
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48

Use Find to delete rows

Change this three lines in the macro before you test it.

 'We use the ActiveSheet but you can also use Sheets("MySheet")
Set sh = ActiveSheet

 'We look in column A in this example
Set myRng = sh.Range("A:A")

 'Add more search strings if you need
myStrings = Array("Ron", "Dave", "Tom")


Sub Find_Example()
    Dim calcmode As Long
    Dim ViewMode As Long
    Dim myStrings As Variant
    Dim FoundCell As Range
    Dim I As Long
    Dim myRng As Range
    Dim sh As Worksheet

    With Application
        calcmode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    'We use the ActiveSheet but you can also use Sheets("MySheet")
    Set sh = ActiveSheet

    'We search in column A in this example
    Set myRng = sh.Range("A:A")

    'Add more search strings if you need
    myStrings = Array("Ron", "Dave", "Tom")


    With sh

        'We select the sheet so we can change the window view
        .Select

        'If you are in Page Break Preview Or Page Layout view go
        'back to normal view, we do this for speed
        ViewMode = ActiveWindow.View
        ActiveWindow.View = xlNormalView

        'Turn off Page Breaks, we do this for speed
        .DisplayPageBreaks = False

        'We will search the values in MyRng in this example
        With myRng

            For I = LBound(myStrings) To UBound(myStrings)
                Do
                    Set FoundCell = myRng.Find(What:=myStrings(I), _
                                               After:=.Cells(.Cells.Count), _
                                               LookIn:=xlFormulas, _
                                               LookAt:=xlWhole, _
                                               SearchOrder:=xlByRows, _
                                               SearchDirection:=xlNext, _
                                               MatchCase:=False)
                    'Use xlPart If you want to search in a part of the FoundCell
                    'If you use LookIn:=xlValues it will also delete rows with a
                    'formula that evaluates to "Ron"
                    If FoundCell Is Nothing Then
                        Exit Do
                    Else
                        FoundCell.EntireRow.Delete
                    End If
                Loop
            Next I

        End With

    End With

    ActiveWindow.View = ViewMode
    With Application
        .ScreenUpdating = True
        .Calculation = calcmode
    End With

End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82

Use Specialcells to delete rows

You can find information on this page. http://rondebruin.nl/win/s4/win003.htm