基于特定单元格值删除行的宏，然后删除特定列单元格下的空行

Question

我有代码让我做或者我想要做的。我想创建代码：

1. 查找“NONE”列“S”，并删除该行，并
2. 然后删除其下的所有行，直到它运行到该行的下一个人口稠密的小区，但继续搜索“S”列的其余部分以获得更多“无”。

这里是我到目前为止，但之前或.Rows(i).Delete后加入另一IF问题，或者可以说，它是

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”行删除到“最后一行”。

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

你可以使用自动筛选和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