如果存在特定值，则对宏 VBA 代码进行一些修改以删除行

Question

我在这个网站上找到了一个宏，如果存在特定值，则删除行： https://www.rondebruin.nl/win/s4/win001.htm 我正在尝试修改此代码，以便不仅可以手动输入：

• 我要修改的列（例如 A）

• 还有我要删除的字符串。

这就是我在代码中手动添加以下数据的原因：

Dim Columnname As String
Dim DeleteStr As String
Columnname = Application.InputBox("Select Column", xTitleId, Type:=2)
DeleteStr = Application.InputBox("Delete Text", xTitleId, Type:=2)
            With .Cells(Lrow, " & Columnname & ")
If .Value = " & DeleteStr & " Then .EntireRow.Delete

我在运行代码时遇到的问题：我遇到了一个出现“运行时错误 13”类型不匹配的窗口……确实，似乎在线上有不匹配错误： 使用 .Cells(Lrow, " & Columnname & ")

不幸的是，我无法确定错误的来源。如果有人可以帮助我，那就太好了。

提前非常感谢您。 哈维

请在下面找到我的代码：

 Sub Loop_Example()
    Dim Firstrow As Long
    Dim Lastrow As Long
    Dim Lrow As Long
    Dim CalcMode As Long
    Dim ViewMode As Long
Dim Columnname As String
Dim DeleteStr As String


Columnname = Application.InputBox("Select Column", xTitleId, Type:=2)
DeleteStr = Application.InputBox("Delete Text", xTitleId, Type:=2)

    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    'We use the ActiveSheet but you can replace this with
    'Sheets("MySheet")if you want
    With ActiveSheet

        'We select the sheet so we can change the window view
        .Select

        'If you are in Page Break Preview Or Page Layout view go
        'back to normal view, we do this for speed
        ViewMode = ActiveWindow.View
        ActiveWindow.View = xlNormalView

        'Turn off Page Breaks, we do this for speed
        .DisplayPageBreaks = False

        'Set the first and last row to loop through
        Firstrow = .UsedRange.Cells(1).Row
        Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row

        'We loop from Lastrow to Firstrow (bottom to top)
        For Lrow = Lastrow To Firstrow Step -1

            'We check the values in the selected column in this example
            With .Cells(Lrow, " & Columnname & ")

                If Not IsError(.Value) Then

                    If .Value = " & DeleteStr & " Then .EntireRow.Delete
                    'This will delete each row with the Value "DeleteStr"
                    'in the seleted Column, case sensitive.

                End If

            End With

        Next Lrow

    End With

    ActiveWindow.View = ViewMode
    With Application
        .ScreenUpdating = True
        .Calculation = CalcMode
    End With

End Sub

Answer 1

使用自动过滤器删除行比使用循环容易得多。

Sub test()
Dim Columnname As String
Dim DeleteStr As String
Columnname = Application.InputBox("Select Column", xTitleId, Type:=2)
DeleteStr = Application.InputBox("Delete Text", xTitleId, Type:=2)

With ActiveSheet
    .AutoFilterMode = False
    With .Range(Columnname & "1", .Range(Columnname & Rows.Count).End(xlUp))
        .AutoFilter 1, DeleteStr
        On Error Resume Next
        .Offset(1).SpecialCells(12).EntireRow.Delete
    End With
    .AutoFilterMode = False
End With
End Sub

Answer 2

您的变量不需要引号：

    '...
    With .Cells(Lrow, Columnname)

        If Not IsError(.Value) Then

            If .Value =  DeleteStr  Then .EntireRow.Delete
            'This will delete each row with the Value "DeleteStr"
            'in the seleted Column, case sensitive.

        End If

    End With
    '...

Answer 3

与限定范围的 Union 一起删除更有效。并且要仅循环必要的行数，请使用所选列来确定要确定循环的最后一行。您还可以通过设置一个变量来保存要循环的单元格并在其上使用For Each 来重写以在集合上使用有效的For Each Loop。

Option Explicit
Public Sub Loop_Example()
    Dim Firstrow As Long, Lastrow As Long, Lrow As Long, CalcMode As Long, ViewMode As Long, Columnname As String
    Dim DeleteStr As String, unionRng As Range, rng As Range

    Columnname = Application.InputBox("Select Column", , Type:=2)
    DeleteStr = Application.InputBox("Delete Text", , Type:=2)

    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    With ActiveSheet

        .Activate

        ViewMode = ActiveWindow.View
        ActiveWindow.View = xlNormalView

        .DisplayPageBreaks = False

        Firstrow = .UsedRange.Cells(1).Row
        Lastrow = .Cells(.Rows.Count, Columnname).End(xlUp).Row
        Dim loopRange As Range: Set loopRange =  .Range("C" & Firstrow & ":" & "C" & Lastrow)
        For Each rng In loopRange
            If rng.Value = DeleteStr Then
                If Not unionRng Is Nothing Then
                    Set unionRng = Union(unionRng, rng)
                Else
                    Set unionRng = rng
                End If
            End If
        Next
    End With

    ActiveWindow.View = ViewMode
    With Application
        .ScreenUpdating = True
        .Calculation = CalcMode
    End With
    If Not unionRng Is Nothing Then unionRng.EntireRow.Delete
End Sub