关于宏 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

我在运行代码时遇到的问题：我遇到一个 windows 出现“运行-time error 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

您的变量不需要引号：

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

与排位区间并联，一次性删除效率更高。并仅循环必要的行数，使用所选列来确定最后一行以确定循环。您还可以通过设置一个变量来让您的单元格循环并在其上使用 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

Answer 3

使用自动筛选器删除行比使用循环要容易得多。

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

关于宏 VBA 代码的一些修改，如果特定值存在则删除行

Some modification regarding macro VBA code to delete row if a specific value exist

excel

vba

inputbox