使用另一張工作表中的列中的值從excel中刪除行？

Question

我正在處理一個包含多列和大約 6000 行的 excel 工作表。 Sheet1 將包含主要信息。（6000 行和列到 R）。 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 函數可以接受通配符匹配，但您需要顛倒識別要刪除的行的方式。 只需用星號為標准 rtem 加上前綴和后綴（例如Chr(42) ）。

您的代碼沒有刪除多於一次的標准值。 可能更好地循環它直到沒有更多匹配項。 由於 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

這將比識別要刪除的非連續行的塊或聯合更耗時，但它會完成工作。 關閉屏幕更新和計算等環境變量，以在您滿意后加快速度。

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