Makro, das löscht Zeilen basierend auf bestimmten Zelle Wert, löscht dann die leeren Zeilen unter dieser bestimmten Spalte Zelle

Question

Ich habe Code, lassen Sie mich tun entweder/oder von dem, was ich suche zu tun. Ich versuche, den Code zu erstellen, die:

1. Sucht „NONE“ in der Spalte „S“ und löscht diese Zeile, und
2. löscht dann alle Zeilen darunter, bis es in dieser Reihe in die nächste besiedelte Zelle läuft, aber sucht weiterhin den Rest der Spalte "S" nach mehr "NONE". Hier

ist, was ich habe, so weit, aber ist das Problem ein anderes IF Zugabe vor oder nach dem .Rows(i).Delete oder könnte es

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

Die einfachste Änderungen an Ihrem vorhandenen Code sein ist Setzen Sie einfach eine Variable, die die letzte Zeile angibt, die Sie löschen möchten, und löschen Sie dann alles aus der Zeile "NONE" in die "letzte Zeile", wenn Sie "NONE" finden.

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

Sie konnten verwenden Autofilter und Special

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