Question

我需要在K列中搜索一组电子邮件地址，并使用@ noemail.com删除所有行。下面是我的代码尝试。它以前工作但只会一次删除一行，迫使我多次运行宏。

`Sub Prospects()
'
' Prospects Macro
'
' Delete rows with @noemail.com
    Dim rng As Range
    Dim row As Range
    Dim ContainWord As String
' Select range in column K
    Range("K2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Set rng = Selection
' Set noemail as word to search for
    ContainWord = "noemail"
' Loop through each cell in range, test cell contents and clear noemail.com rows
    For Each row In rng.Cells
        If Not row.Find(ContainWord) Is Nothing Then rng.EntireRow.Delete
    Next row
    Range("B2").Select
End Sub

Answer 1

问题在于这一行：

If Not row.Find(ContainWord) Is Nothing Then rng.EntireRow.Delete

特别是最后一部分：rng.EntireRow.Delete。 rng是整个选择，而不仅仅是那些被过滤的选择。你是逐个单元格，然后当它找到一个返回True时，它会删除rng

的顶行

通过将rng更改为row，您应该会获得所需的效果。就像这样：

If Not row.Find(ContainWord) Is Nothing Then row.EntireRow.Delete

编辑处理循环：

问题是，当它删除一行时，它会移动到下一个单元格。如果删除的那一行下方的行中有“noemail”，则将其移动到您刚刚测试的行中并跳过它。

试试这个：

Sub Prospects()
' Delete rows with @noemail.com
Dim ContainWord As String
Dim i As Integer
i = 2 ' i is a counter

' Set noemail as word to search for
ContainWord = "noemail"
' Loop through each cell in column K, test cell contents and clear noemail.com rows
Do While Range("K" & i) <> ""
    If Not Range("K" & i).Find(ContainWord) Is Nothing Then
        Range("K" & i).EntireRow.Delete
    Else
        i = i + 1
    End If
Loop
Range("B2").Select
End Sub`

这将保留在删除坏地址的同一行，直到遇到一个好地址然后移到下一个地址。

搜索特定文本列，并删除包含该文本的整行

1 个答案: