Мой код не удалит строки ненужных данных под данными, которые я пытаюсь сохранить

Question

Sub DeleteExtraValues ()

    Dim I as Integer, strValueToFind As String, lngRows As           Long, she As Worksheet
     Set an = ThisWorkbook.ActiveSheet
     LngRows = sh.Range(“A1048576”).End(xlUp).Row
     strValueToFind = “DCAP”
     For I = 1 To lngRows
        If InStr(Cells(I,1).Value, strValueToFind) = 0 Then
           If Cells(I,1).Value = “” Then
           Else
               Rows(I).Delete
                I = I-1
           End If
      End If
    Next I
End Sub

При запуске он удалит ячейки над данными, которые я хочу сохранить, а затем остановится, как только доберется до первой ячейки, содержащей «DCAP». Мне также нужно удалить любую ненужную информацию после последней ячейки, которая содержит «DCAP».

Answer 1

Попробуйте этот код.Он удаляет все строки, которые не содержат DCAP в первом столбце.

Dim r As Long
Dim LastRow As Long

r = 1
LastRow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row

Do Until r > LastRow
   DoEvents
   If InStr(1, Cells(r, 1), "DCAP") > 0 Then
        r = r + 1
   Else 
        Cells(r, 1).EntireRow.Delete
        LastRow = LastRow - 1
   End If

Loop

MsgBox 

"done"

Answer 2

Попробуйте это ...

    Dim rng As Range
    Set rng = ActiveSheet.Range("A1").CurrentRegion 'depending on your data you may have to change to a specific range using last row and column

' change the `Field` to the column that contains "DCAP"   
    With rng 
        .AutoFilter Field:=9, Criteria1:="<>DCAP", Operator:=xlAnd 'select all cells that are not "DCAP"
        .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete 'don't delete the header row
        .AutoFilterMode = False
    End With