根據多個條件刪除行

Question

你能幫我用下面的代碼嗎？

Sub DeleteRows() 
Dim c As Range 
Dim SrchRng 

Set SrchRng = ActiveSheet.Range("A1", ActiveSheet.Range("A65536").End(xlUp)) 
Do 
    Set c = SrchRng.Find("12345", LookIn:=xlValues) 
    If Not c Is Nothing Then c.EntireRow.Delete 
Loop While Not c Is Nothing 

末次

我有A列中的程序代碼的圖表，我想創建一個宏，將刪除與特定的程序代碼的所有行：12345，541，9099，等等 的我有的代碼只能引用一個值。我不知道如何添加更多。最重要的是，它將刪除其中包含「12345」的程序代碼。例如，它將刪除程序代碼爲123456的行。我們是否也可以阻止它這樣做？

P.S.不知道像我這樣設置範圍是個好主意：A1：A65536。太大？

謝謝！

Answer 1

你應該改寫範圍。如果你沒有那麼多的數據，你也不想設置那麼大的範圍。

Sub DeleteRows() 
    Dim i As Long 
    Dim last_row As Long 
    last_row = ActiveSheet.Range("A65536").End(xlUp).Row 
    For i = last_row To 1 Step -1 
     If ActiveSheet.Cells(i, 1).Value = "12345" or _ 
      ActiveSheet.Cells(i, 1).Value = "541" or _ 
      ActiveSheet.Cells(i, 1).Value = "9099" Then 
      ActiveSheet.Cells(i, 1).EntireRow.Delete 
     End If 
    Next i 
End Sub 

Answer 2

這樣你就可以去了該數組裏面與要檢查裏面的數據值/字符串：

Sub DeleteRows() 
    Dim c As Range 
    Dim i 
    Dim r 
    Dim theValues(1 To 5) 
    Dim SrchRng As Range 

    theValues(1) = "1231" 
    theValues(2) = "1232" 
    theValues(3) = "1233" 
    theValues(4) = "1234" 
    theValues(5) = "1235" 

    r = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row 
    Set SrchRng = Range(Cells(1, 1), Cells(r, 1)) 
    For Each i In theValues 
     Do 
      Set c = SrchRng.Find(i, LookIn:=xlValues, LookAt:=xlWhole) 
      'see the ", LookAt:=xlWhole" added, this way you can find just the Whole values. 
      If Not c Is Nothing Then c.EntireRow.Delete 
     Loop While Not c Is Nothing 
    Next i 
End Sub 

編輯＃1 當您在留言問，請參閱編輯以便：查看僅顯示完整值的數據（您可以查找91而不是910或1891），然後繼承人是我的版本，如果要將值放入工作表中的某個範圍內，則可以添加任何值被發現。

Sub DeleteRows() 
    Dim c As Range 
    Dim i 
    Dim r 
    Dim rng As Range 
    Dim a 
    Dim theValues() 
    Dim SrchRng As Range 

    r = Range("T1").End(xlDown).Row 
    Set rng = Range("T1", Cells(r, 20)) 

    For a = 1 To rng.Count 'in this range i store the values 
     ReDim Preserve theValues(1 To a) 
     theValues(a) = rng(a) 
    Next a 

    r = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row 
    Set SrchRng = Range(Cells(1, 1), Cells(r, 1)) 
    For Each i In theValues 
     Do 
      Set c = SrchRng.Find(i, LookIn:=xlFormulas, LookAt:=xlWhole) 
      If Not c Is Nothing Then c.EntireRow.Delete 
     Loop While Not c Is Nothing 
    Next i 
End Sub