宏刪除除包含某些文本的行以外的所有行

Question

我試圖編寫一個宏，它將刪除除包含某些特定文本的行之外的每一行。

我需要有以下條件：

• 從不刪除第一2行
• 排除其中單詞「索姆」可以在列C中發現的行或D.

請注意，單詞Somme如果列C或D中的字符串的一部分。發現的文本的示例將類似於：

S OMME阿爾法/ 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 

編輯＃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