根据多个条件删除行

时间:2016-03-07 15:56:57

标签: excel vba macros

你可以帮我解决下面的代码吗?

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

End Sub

我在A栏中有一个包含程序代码的图表。我想创建一个宏,它将删除具有特定程序代码的所有行:12345,541,9099等。 我的代码只能引用一个值。我不知道如何添加更多。最重要的是,它将删除其中包含“12345”的程序代码。例如,它将使用程序代码删除行:123456。我们可以阻止它这样做吗?

P.S。不确定是否像我一样设置范围是个好主意:A1:A65536。太大了?

谢谢!

2 个答案:

答案 0 :(得分:2)

您应该迭代范围。如果没有那么多数据,你也不想设置那么大的范围。

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

答案 1 :(得分:1)

通过这种方式,您可以使用要在数据中检查的值/字符串来检查数组中的值:

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而不是9101891),那么继承人是我的版本如果要将值放在工作表中的范围内,则可以添加要查找的任何值。

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