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

时间:2016-01-22 21:12:30

标签: excel vba excel-vba excel-2010 autofilter

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

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

例如:当我运行它时,它将查找并删除仅包含单词hello的每一行。但不是你好世界或你好foo。我需要这个来删除hello world和hello foo的行。

我试图以这种方式设置它,这样我就可以在我的例外列表中添加更多项目,并根据需要删除更多行。

Contestant

如何使其不那么具体?我理解它是如何工作的并且正在找到完全匹配但我需要它来查找和删除该行,如果找到该值与其他任何字符的组合。

2 个答案:

答案 0 :(得分:3)

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

这比识别要删除的非连续行的块或联合要花费更多时间,但它会完成工作。关闭屏幕更新和计算等环境变量,一旦运行满意,就可以加快速度。

答案 1 :(得分:1)

下面假设您要搜索的单词列表位于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