保留所有具有特定文本的行，并删除其余的行

我正在使用此代码删除所有工作表中具有特定文本的所有行。 有什么办法可以保留所有的行与特定的文本，并删除其余的？ 非常感谢您的帮助。

Sub WorksheetLoop() Dim c As Integer Dim n As Integer c = ActiveWorkbook.Worksheets.Count For n = 1 To c Step 1 Last = Worksheets(n).Cells(Rows.Count, "A").End(xlUp).Row For i = Last To 1 Step -1 If (Worksheets(n).Cells(i, "A").Value) = "Oakville" Then Worksheets(n).Cells(i, "A").EntireRow.Delete End If Next i Next n End Sub 

Answer 1

例如，如果你想要'Oakville'的行，那么就在这个代码本身中改变= <>

 Sub WorksheetLoop() Dim c As Integer Dim n As Integer c = ActiveWorkbook.Worksheets.Count For n = 1 To c Step 1 Last = Worksheets(n).Cells(Rows.Count, "A").End(xlUp).Row For i = Last To 1 Step -1 If (Worksheets(n).Cells(i, "A").Value) <> "Oakville" Then Worksheets(n).Cells(i, "A").EntireRow.Delete End If Next i Next n End Sub 

Answer 2

另一种方法来实现这一点如下…

 Sub DeleteRows() Dim ws As Worksheet Dim LastRow As Long, LastCol As Long Application.ScreenUpdating = False For Each ws In Worksheets LastRow = ws.UsedRange.Rows.Count LastCol = ws.UsedRange.Columns.Count + 1 With ws .Range(.Cells(1, LastCol), .Cells(LastRow, LastCol)).Formula = "=IF(A1=""Oakville"","""",NA())" On Error Resume Next .Range(.Cells(1, LastCol), .Cells(LastRow, LastCol)).SpecialCells(xlCellTypeFormulas, 16).EntireRow.Delete .Columns(LastCol).Clear End With Next ws Application.ScreenUpdating = True End Sub 

Answer 3

考虑一下AutoFilter方式，不需要循环，不用担心删除的顺序，也不需要一一删除; 它一次性去除不需要的行。 这绝对是我推荐的方法，试试吧：

 Dim ws As Worksheet For Each ws In ThisWorkbook.Worksheets With ws.UsedRange .AutoFilter 1, "<>Oakville" .Offset(1).EntireRow.Delete .AutoFilter End With Next 

这节省了“奥克维尔”。 删除那些<>删除“奥克维尔”。