創建一個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的第一個匹配項，這就是為什么它不刪除多於一行的原因。