vba - 创建 Excel 宏以一次删除多行

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，这就是为什么它没有删除更多的一行。