在Excel中查找多个单词并使用VBA删除行

Question

我尝试根据我在堆栈中找到的两个脚本创建自己的脚本，但无法使其正常运行。 因此，我想做的是在excel文档中找到某些单词，然后删除数据所在的行。

我要查找的字符串模式最终会随着时间增长，因此我需要能够更新数组并让我的vba脚本删除与该模式匹配的任何行。

Sub Deletrows_Click()

Dim WS As Worksheet
Dim pattern As String
Dim MyVar

For Each WS In ThisWorkbook.Worksheets
    With WS
        pattern = "string 1/ string 2/ string 3"
        MyVar = Split(pattern, "/")

        RowCount = ActiveSheet.UsedRange.Rows.Count

        Dim i As Integer
        For i = 2 To RowCount
            Dim j As Integer
            For j = 1 To 3 'find the word within this range
                If Cells(i, j) = pattern Then
                    Cells(i, j).EntireRow.Delete
                End If
            Next j
        Next i
    End With
Next WS

End Sub

Answer 1

首先 ，您拥有With WS但是其中的所有对象都没有被With语句引用，因为您缺少. 。

因此， RowCount = .UsedRange.Rows.Count RowCount = ActiveSheet.UsedRange.Rows.Count应该是RowCount = .UsedRange.Rows.Count 。 而且If Cells(i, j)...应该是If .Cells(i, j)...

其次 ，一种检查是否在数组中找到某个单元格中的字符串的好方法，对于您的情况MyVar ，其中包含所有pattern ，请使用Match函数：

If Not IsError(Application.Match(.Cells(i, j).Value, MyVar, 0)) Then

下面的代码内有更多说明：

码

Option Explicit

Sub Deletrows_Click()

Dim WS As Worksheet
Dim pattern As String
Dim MyVar
Dim RowCount As Long, i As Long, j As Long
Dim DelRng As Range

' take it outside the loop, no need to re-create the array every time inside the loop
pattern = "string 1/ string 2/ string 3"
MyVar = Split(pattern, "/")

For Each WS In ThisWorkbook.Worksheets
    With WS
        RowCount = .UsedRange.Rows.Count

        For i = 2 To RowCount
            For j = 1 To 3 'find the word within this range

                ' you can use Match to see if cell's value is found within an array
                If Not IsError(Application.Match(.Cells(i, j).Value, MyVar, 0)) Then
                    If Not DelRng Is Nothing Then
                        Set DelRng = Application.Union(DelRng, .Cells(i, j))
                    Else
                        Set DelRng = .Cells(i, j)
                    End If
                End If
            Next j
        Next i
    End With

    ' after looping through all cells, delete all rows with words in pattern at onc shot
    If Not DelRng Is Nothing Then DelRng.EntireRow.Delete shift:=xlShiftUp

    Set DelRng = Nothing ' reset range object
Next WS

End Sub