Question

我在网上发现了一个代码并希望对其进行编辑。代码在VBA中，我希望宏代码删除多行而不是一行。这是代码：

Sub findDelete()
    Dim c As String
    Dim Rng As Range

    c = InputBox("FIND WHAT?")

    Set Rng = Nothing

    Set Rng = Range("A:A").Find(what:=c, _
        After:=Range("A1"), _
        LookIn:=xlFormulas, _
        lookat:=xlPart, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=False)

    Rng.EntireRow.Delete shift:=xlUp
End Sub

Answer 1

使用Autofilter并删除VisibleCells

，而不是使用查找

Sub findDelete()

Dim c As String, Rng As Range, wks as Worksheet

c = InputBox("FIND WHAT?")

Set wks = Sheets(1) '-> change to suit your needs
Set Rng = wks.Range("A:A").Find(c, After:=Range("A1"), LookIn:=xlFormulas, _
                            lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                            MatchCase:=False)

If Not Rng Is Nothing Then

    With wks

        .Range(.Range("A1"), .Range("A" & .Rows.Count).End(xlUp)).AutoFilter 1, c
        Set Rng = Intersect(.UsedRange, .UsedRange.Offset(1), .Range("A:A")).SpecialCells(xlCellTypeVisible)
        Rng.Offset(1).EntireRow.Delete

    End With

End If

End Sub

修改

将InputBox替换为多个值以查找/删除执行此操作：

Option Explicit Sub FindAndDeleteValues() Dim strValues() as String strValues() = Split("these,are,my,values",",") Dim i as Integer For i = LBound(strValues()) to UBound(strValues()) Dim c As String, Rng As Range, wks as Worksheet c = strValues(i) '.... then continue with code as above ... Next End Sub

Answer 2

将其封装在While循环中。

Sub findDelete()
    Dim c As String
    Dim Rng As Range
    c = InputBox("FIND WHAT?")
    Set Rng = Nothing
    Do While Not Range("A:A").Find(what:=c) Is Nothing
        Set Rng = Range("A:A").Find(what:=c, _
        After:=Range("A1"), _
        LookIn:=xlFormulas, _
        lookat:=xlPart, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=False)
        Rng.EntireRow.Delete shift:=xlUp
    Loop
End Sub

Answer 3

您已经拥有了删除Rng.EntireRow.Delete shift:=xlUp中的行的代码，您需要的是将范围设置为要删除的行的代码。像往常一样在VBA中，这可以通过很多方式完成：

'***** By using the Rng object
Set Rng = Rows("3:5")

Rng.EntireRow.Delete shift:=xlUp

Set Rng = Nothing

'***** Directly
Rows("3:5").EntireRow.Delete shift:=xlUp

您的Find语句只会找到c的第一个匹配项，这就是为什么它不会删除多一行的原因。

创建Excel宏以一次删除多个行

3 个答案: