根据特定单元格值删除行的宏，然后删除该特定列单元格

Question

我的代码让我能够或我正在做的事情。我正在尝试创建代码：

1. 查找＆＃34; NONE＆＃34;在专栏＆＃34; S＆＃34;并删除该行，
2. 然后删除它下面的所有行，直到它进入该行中的下一个填充单元格，但继续搜索列的其余部分＆＃34; S＆＃34;更多＆＃34; NONE＆＃34;。

以下是我目前的情况，但问题是在IF之前或之后添加另一个.Rows(i).Delete或者可能是

Sub Helmetpractice()
Const TEST_COLUMN As String = "S"
Dim Lastrow As Long
Dim i As Long
Application.ScreenUpdating = False

With ActiveSheet

    Lastrow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
    For i = Lastrow To 1 Step -1

        If Cells(i, TEST_COLUMN).Value2 Like "NONE" Then
          'this is where I am having trouble for the blank row delete
            .Rows(i).Delete
        End If
    Next i
End With

Application.ScreenUpdating = True
End Sub

Answer 1

对现有代码的最简单修改是只设置一个指定要删除的最后一行的变量，然后每当找到“NONE”时，从“NONE”行到“最后一行”删除所有内容。< / p>

Sub Helmetpractice()
    Const TEST_COLUMN As String = "S"
    Dim Lastrow As Long
    Dim EndRow As Long
    Dim i As Long
    Application.ScreenUpdating = False

    With ActiveSheet

        Lastrow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
        EndRow = Lastrow
        For i = Lastrow To 1 Step -1
            If .Cells(i, TEST_COLUMN).Value2 Like "NONE" Then
                'Cell contains "NONE" - delete appropriate range
                .Rows(i & ":" & EndRow).Delete
                'New end of range is the row before the one we just deleted
                EndRow = i - 1
            ElseIf Not IsEmpty(.Cells(i, TEST_COLUMN).Value) Then
                'Cell does not contain "NONE" - set end of range to be the previous row
                EndRow = i - 1
            End If
        Next i
    End With

    Application.ScreenUpdating = True
End Sub

Answer 2

您可以使用AutoFilter和SpecialCells

Sub Helmetpractice()
    Const TEST_COLUMN As String = "S"
    Dim iArea As Long
    Dim filtRng As Range

    Application.ScreenUpdating = False

    With Range(Cells(1,TEST_COLUMN), Cells(Rows.Count, TEST_COLUMN).End(xlUp))
        .AutoFilter Field:=1, Criteria:=""
        Set filtRng = . SpecialCells(xlCellTypeBlanks)
        .Parent.AutoFilterMode = False
        If .Cells(1,1)= "NONE" Then .Cells(1,1).EntireRow.Delete
    End With
    With filtRng
        For iArea = .Areas.Count to 1 Step - 1
            With .Areas(iArea)
                If .Cells(1,1).Offset(-1) = "NONE" Then .Offset(-1).Resize(.Rows.Count + 1).EntireRow.Delete
            End With 
        Next
    End With
    Application.ScreenUpdating = True
End Sub