如何使用VBA在Excel中搜索单词，然后删除整行？

有人请帮忙。 我试图编写一个VBA代码，在excel工作表的“D”列中搜索特定的单词“DR”，然后删除整行。 工作表中有许多特定单词出现。我所要做的就是搜索这些出现的单词，然后删除包含这些单词的整行。 我的问题是我不确定使用什么循环结构。 下面是我正在使用的代码。 Columns("D:D").Select Cells.Find(What:="DR", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ , SearchFormat:=False).Activate
Do Cells.Find(What:="DR", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ , SearchFormat:=False).Activate

   ActiveCell.EntireRow.Delete

Loop While (Cells.Find(What:="DR"))

---

我很高兴能得到帮助。

干净利落，做到了！；）

另一条路（最快的路）

假设您的工作表如下所示

您可以使用Excel来做脏活；）使用

.AutoFilter

请参阅此代码

Sub Sample()
    Dim ws As Worksheet
    Dim lRow As Long
    Dim strSearch As String

    '~~> Set this to the relevant worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    '~~> Search Text
    strSearch = "DR"

    With ws
        '~~> Remove any filters
        .AutoFilterMode = False

        lRow = .Range("D" & .Rows.Count).End(xlUp).Row

        With .Range("D1:D" & lRow)
            .AutoFilter Field:=1, Criteria1:="=*" & strSearch & "*"
            .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        End With

        '~~> Remove any filters
        .AutoFilterMode = False
    End With
End Sub

输出：

---

还有另一种使用查找的方法

Sub TestDeleteRows()
Dim rFind As Range
Dim rDelete As Range
Dim strSearch As String
Dim sFirstAddress As String

strSearch = "DR"
Set rDelete = Nothing

Application.ScreenUpdating = False

With Sheet1.Columns("D:D")
    Set rFind = .Find(strSearch, LookIn:=xlValues, LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=False)
    If Not rFind Is Nothing Then
        sFirstAddress = rFind.Address
        Do
            If rDelete Is Nothing Then
                Set rDelete = rFind
            Else
                Set rDelete = Application.Union(rDelete, rFind)
            End If
            Set rFind = .FindNext(rFind)
        Loop While Not rFind Is Nothing And rFind.Address <> sFirstAddress

        rDelete.EntireRow.Delete

    End If
End With
Application.ScreenUpdating = True
End Sub

---

为什么这是最快的方法？@t.thielemans:2个原因

1

您没有循环，如果存在大量数据，则删除循环中的行

2

Autofilter比循环更快。试试看，用计时器计时：）哦：）谢谢你的提示@巴特：我正在删除我的评论，直到

Oooh:）谢谢你的提示t、 thielemans

，这样这篇文章就不会显得杂乱无章了。：）请求您发送到相同的@t。thielemans@siddharth-rout:我重新运行了所有的程序，所有程序都关闭了屏幕更新。。。蒂勒曼和我的（第二个例子）花了29-30秒，希德-你的花了40-50秒。。。我在我们每个人之间交替运行了大约3次…考虑到原始代码使用

LookAt:=xlPart

上述代码将无法正常工作。使用

If Range（“D”&i）.像“*DR*”这样的值，那么
应该可以工作，但我还没有测试过它。
Sub TestDeleteRows()
Dim rFind As Range
Dim rDelete As Range
Dim strSearch As String
Dim sFirstAddress As String

strSearch = "DR"
Set rDelete = Nothing

Application.ScreenUpdating = False

With Sheet1.Columns("D:D")
    Set rFind = .Find(strSearch, LookIn:=xlValues, LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=False)
    If Not rFind Is Nothing Then
        sFirstAddress = rFind.Address
        Do
            If rDelete Is Nothing Then
                Set rDelete = rFind
            Else
                Set rDelete = Application.Union(rDelete, rFind)
            End If
            Set rFind = .FindNext(rFind)
        Loop While Not rFind Is Nothing And rFind.Address <> sFirstAddress

        rDelete.EntireRow.Delete

    End If
End With
Application.ScreenUpdating = True
End Sub

Sub TestDeleteRows()
Dim rFind As Range
Dim rDelete As Range
Dim strSearch As String

strSearch = "DR"
Set rDelete = Nothing

Application.ScreenUpdating = False

With Sheet1.Columns("D:D")
    Set rFind = .Find(strSearch, LookIn:=xlValues, LookAt:=xlPart, SearchDirection:=xlPrevious, MatchCase:=False)
    If Not rFind Is Nothing Then
        Do
            Set rDelete = rFind
            Set rFind = .FindPrevious(rFind)
            If rFind.Address = rDelete.Address Then Set rFind = Nothing
            rDelete.EntireRow.Delete
        Loop While Not rFind Is Nothing
    End If
End With
Application.ScreenUpdating = True
End Sub