Macro для удаления всех строк, кроме тех, которые содержат определенный текст

Question

Я пытаюсь написать макрос, который удалит каждую строку, кроме тех, которые содержат определенный текст.

мне нужно иметь следующие критерии:

• Никогда не удаляйте первые 2 строки
• Исключить строки, где слово «Сом» можно найти в колонке C или D.

Обратите внимание на слово Somme, если оно является частью строки в столбце C или D. Примером найденного текста может быть примерно:

S Омме альфа/000284727819293

То, что я до сих пор является код, который удаляет строки с Сомме в нем, однако мне нужно наоборот:

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 

EDIT # 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