基於特定單元格值刪除行的宏，然後刪除特定列單元格下的空行

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