Question

我正在尝试遍历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

Answer 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

Answer 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

VBA循环表：如果单元格不包含，则删除行

2 个答案: