使用另一个表中的列中的值从Excel中删除行？

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

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

例如：当我运行它时，它会发现并删除每一行，只包含单词hello。 但不是你好世界或你好富。 我需要这个用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 

我怎样才能使这个不太具体？ 我知道它是如何工作，并find完全匹配，但我需要它来查找和删除该行，如果该值与任何其他字符的组合find它。

Answer 1

MATCH函数可以接受通配符匹配，但是您需要反转识别要删除的行的方式。 简单地用星号（如Chr(42) ）作为前缀和后缀标准rtem。

您的代码不会删除多于一次的条件值。 可能更好地循环，直到没有更多的比赛。 由于MATCH在不匹配时返回一个错误，最好依靠COUNTIF函数返回一个大于零的值。

 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 

这比识别要删除的非连续行的块或联合会花费更多的时间，但它会完成工作。 closures环境variables，如屏幕更新和计算，以加快速度，一旦运行到您满意。

Answer 2

下面假设你要search的单词列表在Sheet2列A中，并在列表中检查它们是Sheet1列起始行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