VBA循环工作表：如果单元格不包含则删除行答案

【问题标题】：VBA Looping Over Sheets: Delete rows if cell doesn't containVBA循环工作表：如果单元格不包含则删除行
【发布时间】：2013-08-02 14:12:14
【问题描述】：

我正在尝试遍历 Excel 工作表以删除不包含“ALTW.ARNOLD_1”或“DECO.FERMI2”的行。我已经组装了以下代码，它适用于单个工作表，但是当我循环时，循环只会遍历所有工作表，而只在第一张工作表上执行行删除。工作表编号为 1 到 365。代码如下：

Sub Delete_Rows()

For x = 1 To 365
    Sheets(x).Select
    Dim rng As Range, cell As Range, del As Range
    Set rng = Intersect(Range("A1:A5000"), ActiveSheet.UsedRange)
    For Each cell In rng
    If (cell.Value) <> "ALTW.ARNOLD_1" And (cell.Value) <> "DECO.FERMI2" _
    Then
    If del Is Nothing Then
    Set del = cell
    Else: Set del = Union(del, cell)
    End If
    End If
    Next cell
    On Error Resume Next
    del.EntireRow.Delete
Next x

End Sub

【问题讨论】：

标签： excel loops row vba

【解决方案1】：

完全避免选择/激活会更安全。您也没有在每次循环后重置del...

Sub Delete_Rows()

Dim rng As Range, cell As Range, del As Range
dim sht as Worksheet

For x = 1 To 365
    set sht=Sheets(x)
    set del=Nothing 'you missed this

    Set rng = Intersect(sht.Range("A1:A5000"), sht.UsedRange)
    For Each cell In rng.Cells
    If (cell.Value) <> "ALTW.ARNOLD_1" And (cell.Value) <> "DECO.FERMI2" _
    Then
        If del Is Nothing Then
            Set del = cell
        Else
            Set del = Union(del, cell)
        End If
    End If
    Next cell
    If not del is nothing then del.EntireRow.Delete
Next x

End Sub

【讨论】：

谢谢！每次循环后未能重置 del 是问题所在。您能否阐明避免选择/激活“更安全”的意思？无论如何，按照您列出的方式进行操作似乎更清洁。
我的意思是最好直接引用一个对象，例如工作表或工作簿，而不是选择/激活它，然后在使用Activesheet/Activeworkbook 时依赖它保持活动状态。有时这会意外中断，因为其他工作表/工作簿可能会在您的代码完成之前以某种方式变为活动状态。例如。用户点击某物，某些加载项响应事件并更改活动对象等。

【解决方案2】：

del 是一个单元格区域，当你到达EntireRow.Delete 行时，你需要循环遍历del 区域中的每个单元格。

For x = 1 To 365
    Sheets(x).Select
    Dim rng As Range, cell As Range, del As Range
    Set rng = Intersect(Range("A1:A5000"), ActiveSheet.UsedRange)
    For Each cell In rng
    If (cell.Value) <> "ALTW.ARNOLD_1" And (cell.Value) <> "DECO.FERMI2" _
    Then
    If del Is Nothing Then
    Set del = cell
    Else: Set del = Union(del, cell)
    End If
    End If
    Next cell
    On Error Resume Next
    For each cell in dell.cells
        cell.EntireRow.Delete
    Next cell
Next x

【讨论】：