如何在所有表格中自动删除Excel中包含“删除”的所有行？

我有不同的表格叫：

“香槟酒”
“水”
“ChocoStrawb”
“青铜”
“银”
“金”
“铂”
“PlPlus”
“大使”

我有这个代码：

Sheets("water").Select Dim rng As Range, cell_search As Range, del As Range Set rng = Intersect(Range("A2:A4200"), ActiveSheet.UsedRange) For Each cell_search In rng If (cell_search.Value) = "Delete" Then If del Is Nothing Then Set del = cell_search Else: Set del = Union(del, cell_search) End If End If Next cell_search On Error Resume Next del.EntireRow.Delete 

但是，只删除表格“水”中的行，我希望这在所有表中都有效。

Answer 1

您可以创build一个macros，通过工作簿中的每个工作表运行：

 Sub AllWorkbooks() Dim WS As Worksheet For Each WS In ActiveWorkbook.Worksheets For x = 4200 To 2 Step -1 If WS.Cells(x, 1).Value = "Delete" Then WS.Rows(x).EntireRow.Delete End If Next x Next WS End Sub 

Answer 2

Autofilter()会加快速度

你可以从一个Sub开始，“处理”一个传递的worksheet对象：

 Sub DeleteRowsWithKeyword(sht As Worksheet, keyWord As String) With sht '<--| reference passed sht With .Range("A1", .cells(.Rows.Count, 1).End(xlUp)) '<--| reference its column A range form row 1 (header) down to its last not empty row .AutoFilter Field:=1, Criteria1:=keyWord '<--| filter cells with passed 'keyWord' If Application.WorksheetFunction.Subtotal(103, .cells) > 1 Then .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete '<--| if any filtered cells other than header then delete their entore row End With .AutoFilterMode = False End With End Sub 

然后你可以让你的“主”子利用它

• 通过所有的工作表循环

   Sub Main() Dim sht As Worksheet For Each sht In Worksheets DeleteRowsWithKeyword sht, "Delete" Next End Sub 

• 循环遍历所有的名字：

   Sub Main() Dim sheetNames As Variant, shtName As Variant sheetNames = Array("Champagne", "Water", "ChocoStrawb", "Bronze", "Silver", "Gold", "Platinum", "PlPlus", "Ambassador") '<--| list all your relevant sheet names here For Each shtName In sheetNames DeleteRowsWithKeyword Sheets(shtName), "Delete" Next End Sub