使用另一个工作表中的列中的值从excel中删除行？

Question

我正在处理一个包含多列和大约 6000 行的 Excel 工作表。 Sheet1 将包含主要信息。（R 的 6000 行和列）。 Sheet2 是我需要用于过滤/删除这些行的例外列表。

现在这就是我正在使用的，它只能找到完全匹配。我需要这个来从 sheet2 中查找异常，即使它们是另一个单词的一部分。

例如：当我运行它时，它将查找并删除仅包含单词 hello 的每一行。但不是 hello world 或 hello foo。我需要这个来删除带有 hello world 和 hello foo 的行。

我正在尝试以这种方式进行设置，以便我可以简单地向我的例外列表中添加更多项目并根据需要删除更多行。

Sub CheckA()
Dim LR As Long, i As Long
With Sheets("IR Temp")
    LR = .Range("A" & Rows.Count).End(xlUp).Row
    For i = LR To 1 Step -1
        If IsNumeric(Application.Match(.Range("A" & i).Value, Sheets("Exceptions").Columns("A"), 0)) Then .Rows(i).Delete
    Next i
End With
End Sub

我怎样才能使这不那么具体？我知道它正在按应有的方式工作并且正在找到完全匹配的内容，但是如果找到该值与其他字符的任何组合，我需要它来查找并删除该行。

Answer 1

MATCH function 可以接受通配符匹配，但您需要反转识别要删除的行的方式。只需在标准 rtem 前加上星号后缀即可（例如 Chr(42) ）。

您的代码没有删除多次出现的条件值。可能更好地循环它，直到没有更多的匹配。由于 MATCH 在不匹配时返回错误，因此最好依靠 COUNTIF function 返回大于零的值。

Sub CheckA()
    Dim str As String, a As Long, vSTRs As Variant

    With Worksheets("Exceptions")
        vSTRs = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)).Value2
    End With

    With Sheets("IR Temp")
        For a = LBound(vSTRs, 1) To UBound(vSTRs, 1)
            If CBool(Len(Trim(CStr(vSTRs(a, 1))))) Then
                str = Chr(42) & vSTRs(a, 1) & Chr(42)
                Do While CBool(Application.CountIf(.Columns(1), str))
                    .Rows(Application.Match(str, .Columns(1), 0)).EntireRow.Delete
                Loop
            End If
        Next a
    End With
End Sub

这将比识别要删除的非连续行的块或联合更耗时，但它会完成工作。关闭屏幕更新和计算等环境变量以加快运行速度。

Answer 2

下面假设您要搜索的单词列表在 Sheet2 A 列中，并且您要检查它们的列表是 Sheet1 A 列起始行 2。可能有比嵌套循环更好的方法，但我们这里有将您的单词列表放入一个数组中，遍历我们想要查看它们是否包含其中一个单词的所有单元格，并为每个单元格循环检查列出的单词之一是否存在。

Public Sub testing()

Dim x As Integer
Dim i As Integer
Dim ws As Worksheet
Dim listws As Worksheet
Dim endList As Integer
Dim endR As Integer
Dim arr() As Variant

Set ws = ThisWorkbook.Worksheets("Sheet1")
endR = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Set listws = ThisWorkbook.Worksheets("Sheet2")
endList = listws.Cells(ws.Rows.Count, "A").End(xlUp).Row
arr = listws.Range("A1:A" & endList)

x = 2
While x <= endR
    For i = 1 To UBound(arr, 1)
        If InStr(ThisWorkbook.Worksheets("Sheet1").Cells(x, 1).Value, arr(i, 1)) > 0 Then
            ThisWorkbook.Worksheets("Sheet1").Cells(x, 1).EntireRow.Delete
        End If
    Next i
    x = x + 1
Wend

End Sub