有关宏VBA代码的一些修改，以在存在特定值时删除行

我在这个网站上找到了一个宏，可以在存在特定值时删除行： 我正在尝试修改此代码，以便不仅能够手动输入：

•我要修改的列（例如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

---

变量周围不需要引号：

    '...
    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
    '...

---

变量周围不需要引号：

    '...
    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
    '...

---

使用合格范围的并集一次性删除更有效。要仅循环必要数量的行，请使用所选列确定最后一行以确定循环。您还可以通过设置一个变量来保存要循环的单元格，并对该集合中的每个使用一个

，对集合中的每个

使用有效的

，从而重新写入

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

使用合格范围的并集一次性删除更有效。要仅循环必要数量的行，请使用所选列确定最后一行以确定循环。您还可以通过设置一个变量来保存要循环的单元格，并对该集合中的每个

使用一个

，对集合中的每个

使用有效的

，从而重新写入

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

使用自动筛选比使用循环更容易删除行

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

使用自动筛选比使用循环更容易删除行

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

首先需要检查值是否存在首先需要检查值是否存在