搜索整個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