根据多个条件删除行

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