根据单元格内容删除行

时间:2017-07-12 19:06:06

标签: excel vba delete-row

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

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

以下是我最近两个版本的宏:

'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

DeleteRowMacro1()的作用:

如果在Q列中有文本或大于0的数字,它将离开行,但它会删除具有0 AND空白单元格的单元格的行。我想用空白单元格保留行。

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

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

DeleteRowMacro2()的作用:

它永远不会停在“结束”。

我必须运行它7或8次才能完全摆脱列Q中的0的所有行。它似乎也随机检查单元格的删除(并且除了前10个左右之外再次)。

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

请注意:点击错误框中的“结束”后,我可以看到该宏的工作方式如上所述。

4 个答案:

答案 0 :(得分:1)

首先,它是avoid using .Select/.Activate的最佳做法。在进行循环/宏时,这可能会导致一些混乱和棘手的写作。

其次,最好避免GoTo

此宏将从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

答案 1 :(得分:1)

试一试,

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

我不确定你是否专门寻找零或零值,所以我包括空白单元格和数字零。

答案 2 :(得分:0)

尝试使用第一个代码的变体:

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

答案 3 :(得分:0)

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

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