特定のセルの値に基づいて行を削除し、その特定の列のセルの下にある空の行を削除するマクロ

Question

私にはのどちらかを実行するコードがありますか、またはです。 、

1. が列「S」で「NONE」を検索していないと、その行を削除し、それがその行の次の人口のセルに実行されるまで
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