vba - 基于文本字符串删除 Excel 单元格（当前代码不起作用）

Question

我正在尝试删除电子表格中包含 TOTAL 字样的所有单元格。我当前的 VBA 代码：

Sub Delete_Rows()
  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) = "TOTAL" _
  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
End Sub

这不起作用，我不明白为什么。抱歉，我说得太含糊了，但显然有一些明显的事情在逃避我。

谢谢

Answer 1

根据我们上面讨论的内容，您正在寻找以下内容：

  Sub Delete_Rows()      
  Dim RNG As Range, cell As Range, del As Range      
  Set RNG = Intersect(Range("A1:A5000"), ActiveSheet.UsedRange)

     For Each cell In RNG
        If InStr(1, UCase(cell.Value), "TOTAL") > 0 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

  End Sub

Answer 2

使用AutoFilteror的代码Find将比范围循环更有效。

此代码来自我的文章Using Find and FindNext to effective delete any rows that contains specific text。

Option Explicit

Const strText As String = "TOTAL"

Sub ColSearch_DelRows()
    Dim rng1 As Range
    Dim rng2 As Range
    Dim cel1 As Range
    Dim cel2 As Range
    Dim strFirstAddress As String
    Dim lAppCalc As Long

    'Get working range from user
    On Error Resume Next
    Set rng1 = Application.InputBox("Please select range to search for " & strText, "User range selection", Columns("A").Address(0, 0), , , , , 8)
    On Error GoTo 0
    If rng1 Is Nothing Then Exit Sub

    With Application
        lAppCalc = .Calculation
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

    'a) match string to entire cell, case insensitive
    'Set cel1 = rng1.Find(strText, , xlValues, xlWhole, xlByRows, , False)

    'b) match string to entire cell, case sensitive
    'Set cel1 = rng1.Find(strText, , xlValues, xlWhole, xlByRows, , True)

    'c)match string to part of cell, case insensititive
    Set cel1 = rng1.Find(strText, , xlValues, xlPart, xlByRows, , False)

    'd)match string to part of cell, case sensititive
    ' Set cel1 = rng1.Find(strText, , xlValues, xlPart, xlByRows, , True)

    'A range variable - rng2 - is used to store the range of cells that contain the string being searched for
    If Not cel1 Is Nothing Then
        Set rng2 = cel1
        strFirstAddress = cel1.Address
        Do
            Set cel1 = rng1.FindNext(cel1)
            Set rng2 = Union(rng2.EntireRow, cel1)
        Loop While strFirstAddress <> cel1.Address
    End If

    'Further processing of found range if required
    'This sample looks to delete rows that contain the text in StrText AND where column A contains "Duplicate"
    If Not rng2 Is Nothing Then rng2.EntireRow.Delete

    With Application
        .ScreenUpdating = True
        .Calculation = lAppCalc
    End With

End Sub