搜索整个Excel工作表并删除没有包含短语的单元格的所有行

Question

我已将几百个XML文件合并在一起，但我有几列有“CCI-”，后面跟着一些数字。我需要保留所有包含字母CCI列的行。我试过这段代码，但它不起作用。有人能帮我一下吗？谢谢

Sub KeepOnlyAtSymbolRows() 
    Dim ws As Worksheet 
    Dim rng As Range 
    Dim lastRow As Long 

    Set ws = ActiveWorkbook.Sheets("Sheet1") 


    Set rng = ws.Range("A3:E70000") 

    ' filter and delete all but header row 
    With rng 
     .AutoFilter Field:=1, Criteria1:="CCI*" 
     .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete 
    End With 

    ' turn off the filters 
    ws.AutoFilterMode = False 
End Sub 

Answer 1

遍历所有列，以排除细胞“CCI”

坚持你原来的代码，你可以采用：

Sub KeepOnlyAtSymbolRows() 
    Dim ws As Worksheet 
    Dim rng As Range 
    Dim lastRow As Long 

    Set ws = ActiveWorkbook.Sheets("Sheet1") 


    Set rng = ws.Range("A3:E70000") 
    Dim col As Range 

    ' filter and delete all but header row 
    With rng 
     For Each col In .Columns 
      .AutoFilter Field:=col.Column, Criteria1:="<>CCI*" 
     Next 
     .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete 
    End With 

    ' turn off the filters 
    ws.AutoFilterMode = False 
End Sub 

虽然重构可以是：

Option Explicit 

Sub KeepOnlyAtSymbolRows() 
    Dim col As Range 

    With ActiveWorkbook.Sheets("Sheet1") 
     With .Range("E3", .cells(.Rows.Count, "A").End(xlUp)) '<--| row 3 must be "header" one 
      For Each col In .Columns 
       .AutoFilter Field:=col.Column, Criteria1:="<>CCI*" 
      Next 
      If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete 
     End With 
     .AutoFilterMode = False ' turn off the filters 
    End With 
End Sub 

Answer 2

它不工作，因为你使相反的自动过滤器。它应该是：

Sub KeepOnlyAtSymbolRows() 
    Dim ws As Worksheet 
    Dim rng As Range 
    Dim lastRow As Long 

    Set ws = ActiveWorkbook.Sheets("Sheet1") 


    Set rng = ws.Range("A3:E70000") 

    ' filter and delete all but header row 
    With rng 
     .AutoFilter Field:=1, Criteria1:="<>*CCI**" 
     .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete 
    End With 

    ' turn off the filters 
    ws.AutoFilterMode = False 
End Sub