删除除包含某些文本的行之外的所有行的宏

Question

我正在尝试编写一个宏，它将删除每一行，除了那些包含一些特定文本的行。

我需要具备以下条件：

• 永远不要删除前 2 行
• 排除在 C 或 D 列中可以找到“Somme”一词的行。

注意，Somme 一词是 C 或 D 列中字符串的一部分。找到的文本示例如下：

Somme alpha/000284727819293

到目前为止，我所拥有的是删除带有 Somme 的行的代码，但是我需要相反的：

Sub CleanUp()
    Dim c As Range
    Dim SrchRng

    Set SrchRng = ActiveSheet.Range("D3", ActiveSheet.Range("D65536").End(xlUp))
    Do
        Set c = SrchRng.Find("Somme", LookIn:=xlValues)
        If Not c Is Nothing Then c.EntireRow.Delete
    Loop While Not c Is Nothing
End Sub

Answer 1

试一试：

Sub SaveSomeRows()
    Dim N As Long, L As Long, r As Range
    Dim s As String, v As String
    Set r = ActiveSheet.Range("D3", ActiveSheet.Range("D65536").End(xlUp))
    N = r.Count
    s = "somme"
    For L = N To 1 Step -1
        v = LCase(r(L).Value)
        If InStr(1, v, s) = 0 Then
            r(L).EntireRow.Delete
        End If
    Next L
End Sub

编辑#1：

宏的初始版本忽略了列C.....试试这个：

Sub SaveSomeRows()
    Dim N As Long, L As Long, r As Range
    Dim s As String, v As String
    Set r = ActiveSheet.Range("D3", ActiveSheet.Range("D65536").End(xlUp))
    N = r.Count
    s = "somme"
    For L = N To 1 Step -1
        v = LCase(r(L).Value & r(L).Offset(-1, 0).Value)
        MsgBox v
        If InStr(1, v, s) = 0 Then
            r(L).EntireRow.Delete
        End If
    Next L
End Sub