我的代码不会删除我要保留的数据下的多余数据行

时间:2019-04-19 20:29:24

标签: excel vba

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”的最后一个单元格之后的所有不必要的信息。

2 个答案:

答案 0 :(得分: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 

“完成”

答案 1 :(得分:0)

尝试一下...

    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