vba 根据单元格内容删除行

Delete Row Based on Cell Contents

提问by Bridget Tharp

I'm trying to check the contents of the cells in column Q and delete the rows that have a 0 in that column.

我正在尝试检查 Q 列中单元格的内容并删除该列中具有 0 的行。

The macro should start checking in column Q at cell Q11 and stop when it encounters the cell containing the text "END". When finished it should select the cell at the upper left corner of the spreadsheet, which would normally be A1, but I have a merged cell there, so it's A1:K2.

宏应该在单元格 Q11 处开始检查 Q 列，并在遇到包含文本“END”的单元格时停止。完成后，它应该选择电子表格左上角的单元格，通常是 A1，但我在那里有一个合并的单元格，所以它是 A1:K2。

Here are my two most recent versions of the macro:

这是我的两个最新版本的宏：

'My second to last attempt

Sub DeleteRowMacro1()
    Dim i As Integer
    i = 11

    Do
        Cells(i, 17).Activate

        If ActiveCell.Value = 0 Then
            ActiveCell.EntireRow.Delete
        End If

       i = i + 1
    Loop Until ActiveCell.Value = "END"
    Range("A1:K2").Select
End Sub




'My last attempt

Sub DeleteRowMacro2()
    Dim i As Integer
        i = 11
        GoTo Filter
Filter:
        Cells(i, 17).Activate
        If ActiveCell.Value = "END" Then GoTo EndingCondition
        If ActiveCell.Value = "" Then GoTo KeepCondition
        If ActiveCell.Value = 0 Then GoTo DeleteCondition
        If ActiveCell.Value > 0 Then GoTo KeepCondition

EndingCondition:
        Range("A1:K2").Select
KeepCondition:
        i = i + 1
        GoTo Filter
DeleteCondition:
        ActiveCell.EntireRow.Delete
        i = i + 1
        GoTo Filter

End Sub

What DeleteRowMacro1() Does:

DeleteRowMacro1() 的作用：

It leaves the row if there is text or a number greater than 0 in column Q, but it deletes the rows with cells with a 0 AND blank cells. I want to keep the rows with the blank cells.

如果 Q 列中有文本或大于 0 的数字，它会离开该行，但它会删除包含 0 和空白单元格的单元格的行。我想保留带有空白单元格的行。

This macro seems to be incapable of checking the 450 or so cells between the Q11 and the cell with "END" in one run. It only deletes about half of the rows it should each time. The first 10 or so rows are always done correctly, but then it appears to randomly choose rows with a zero or a blank in column Q to delete.

这个宏似乎无法在一次运行中检查 Q11 和带有“END”的单元格之间的 450 个左右的单元格。它每次只删除大约一半的行。前 10 行左右总是正确完成，但随后似乎随机选择列 Q 中带有零或空白的行进行删除。

If I run the macro 7 or 8 times, it will eventually delete all of the rows with a 0 and the ones that are blank too. I would like it to completely do it's job in one run and not delete the rows with blank cells.

如果我运行宏 7 或 8 次，它最终会删除所有带有 0 的行和空白的行。我希望它在一次运行中完全完成它的工作，而不是删除带有空白单元格的行。

What DeleteRowMacro2() Does:

DeleteRowMacro2() 的作用：

It never stops at "END".

它永远不会停在“END”处。

I have to run it 7 or 8 times to completely get rid of all of the rows with a 0 in column Q. It also appears to randomly check cells for deletion (and once again besides the first 10 or so).

我必须运行它 7 或 8 次才能完全删除 Q 列中带有 0 的所有行。它似乎还会随机检查单元格是否删除（除了前 10 个左右之外，再一次）。

Because it never ends when I run it, the area of my screen where the spreadsheet is turns black and all I can see there is the green selected cell box flickering up and down at random locations in the Q column until it gets to a row number in the 32,000s. After that my screen returns to show the normal white spreadsheet and a box appears that says Run-time error '6': Overflow.

因为当我运行它时它永远不会结束，电子表格所在的屏幕区域变成黑色，我只能看到绿色选定的单元格框在 Q 列中的随机位置上下闪烁，直到它到达行号在 32,000 年代。之后，我的屏幕返回以显示正常的白色电子表格，并出现一个框，上面写着运行时错误“6”：溢出。

Please note: After I click "End" on the error box I can see that the macro worked as described above.

请注意：在错误框中单击“结束”后，我可以看到宏按上述方式工作。

回答by BruceWayne

First, it's best practice to avoid using .Select/.Activate. That can cause some confusion and tricky writing when doing loops/macros in general.

首先，最好避免使用.Select/.Activate。通常在执行循环/宏时，这可能会导致一些混乱和棘手的写作。

Second, it's also best to avoid GoTo.

其次，最好避免GoTo.

This macro will start at the last row in column Q, and make its way toward row 11. If the value of a cell is 0, it'll delete the row. If the value is END, it selects your range and exits the Forloop, and then exits the sub.

此宏将从 Q 列的最后一行开始，并朝第 11 行移动。如果单元格的值为0，它将删除该行。如果值为END，则它选择您的范围并退出For循环，然后退出子。

Sub delRows()
Dim lastRow As Long, i As Long
Dim ws as Worksheet
Set ws = Worksheets("Sheet1") ' CHANGE THIS AS NECESSARY
lastRow = ws.Cells(ws.Rows.Count, 17).End(xlUp).Row

For i = lastRow To 11 Step -1
    If ws.Cells(i, 17).Value = "END" Then
        ws.Range("A1:K2").Select
        Exit For
    End If

    If ws.Cells(i, 17).Value = 0 or ws.Cells(i, 17).Value = "0" Then
        ws.Cells(i, 17).EntireRow.Delete
    End If
Next i

End Sub

回答by BruceWayne

Try it as,

试试看，

Option Explicit

Sub DeleteRowMacro3()
    Dim rwend As Variant
    With Worksheets("Sheet5")
        If .AutoFilterMode Then .AutoFilterMode = False
        rwend = Application.Match("end", .Range(.Cells(11, "Q"), .Cells(.Rows.Count, "Q")), 0)
        If Not IsError(rwend) Then
            With .Range(.Cells(10, "Q"), .Cells(rwend + 10, "Q"))
                .AutoFilter Field:=1, Criteria1:=0, Operator:=xlOr, Criteria2:=vbNullString
                With .Resize(.Rows.Count - 1, 1).Offset(1, 0)
                    If CBool(Application.Subtotal(103, .Cells)) Then
                        .SpecialCells(xlCellTypeVisible).EntireRow.Delete
                    End If
                End With
            End With
        End If
        .Activate
        .Range("A1:K2").Select
        If .AutoFilterMode Then .AutoFilterMode = False
    End With
End Sub

I wasn't sure if you were looking specifically for zeroes or zero value so I included blank cells as well as numerical zeroes.

我不确定您是专门寻找零还是零值，所以我包括了空白单元格和数字零。

回答by umdjb

Try this simpler, and faster version. It will locate all of the cells you want to delete, store them in a range object, and then delete them all at once at the end.

试试这个更简单、更快的版本。它将定位您要删除的所有单元格，将它们存储在一个范围对象中，然后在最后一次将它们全部删除。

Public Sub DeleteRowsWithRange()

    Dim rngLoop As Range
    Dim rngMyRange As Range

        For Each rngLoop In Columns("Q").Cells

        If rngLoop.Value = "END" Then
            Exit For
        ElseIf rngLoop.Value = 0 Then
            If rngMyRange Is Nothing Then
                Set rngMyRange = rngLoop.EntireRow
            Else
                Set rngMyRange = Union(rngMyRange, rngLoop.EntireRow)
            End If
        End If

        Next rngLoop

        If Not rngMyRange Is Nothing Then rngMyRange.Delete xlShiftUp

        Range("A1").Activate

        Set rngLoop = Nothing
        Set rngMyRange = Nothing

End Sub

回答by ERT

Try this variation of your first code:

试试你的第一个代码的这个变体：

Sub DeleteRowMacro1()
    Dim i As Integer
    i = 11

    Do
        Cells(i, 17).Activate
        If IsEmpty(ActiveCell.Value) Then
            ActiveCell.EntireRow.Delete
        End If
        If ActiveCell.Value = "END" Then
            Exit Do
        End If

       i = i + 1
    Loop 
    Range("A1:K2").Select
End Sub