如何高效删除BARWON工作表中匹配RemoveUnits列表的行？

原脚本的核心问题 #

1. 正向循环删除导致跳行：删除某行后，后续行自动上移，For Each循环会跳过下一行，无法遍历全部目标范围
2. 固定范围限制：硬编码C3:C200/A1:A500，实际数据超出范围会遗漏，少于范围则处理空行
3. 逐个匹配效率低下：循环调用Application.Match每次都要访问工作表，数据量大时卡顿明显

优化方案1：字典+反向循环（通用高效） #

这个方案用字典存储待删除值（O(1)查找效率），反向循环避免跳行，同时适配多工作表批量处理：

Sub RemoveUnits_MultiSheet()
    Dim wsRemove As Worksheet, wsTarget As Worksheet
    Dim removeDict As Object
    Dim targetLastRow As Long, removeLastRow As Long
    Dim i As Long, j As Long
    Dim targetSheets As Variant
    
    ' 替换为你需要处理的所有工作表名称（含BARWON）
    targetSheets = Array("BARWON", "Sheet2", "Sheet3", "Sheet4", "Sheet5")
    
    Set wsRemove = ThisWorkbook.Worksheets("RemoveUnits")
    Set removeDict = CreateObject("Scripting.Dictionary")
    
    ' 关闭冗余设置，大幅提速
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    ' 动态获取RemoveUnits的有效数据行，替代固定范围
    removeLastRow = wsRemove.Cells(wsRemove.Rows.Count, "A").End(xlUp).Row
    ' 将待删除值存入字典，查找速度远快于Match
    For j = 1 To removeLastRow
        If Not removeDict.Exists(wsRemove.Cells(j, "A").Value) Then
            removeDict.Add wsRemove.Cells(j, "A").Value, True
        End If
    Next j
    
    ' 循环处理每个目标工作表
    For Each wsTarget In ThisWorkbook.Worksheets(targetSheets)
        ' 动态获取目标表C列的最后有效行
        targetLastRow = wsTarget.Cells(wsTarget.Rows.Count, "C").End(xlUp).Row
        ' 反向循环删除，避免正向删除导致的跳行问题
        For i = targetLastRow To 3 Step -1
            If removeDict.Exists(wsTarget.Cells(i, "C").Value) Then
                wsTarget.Rows(i).Delete
            End If
        Next i
    Next wsTarget
    
    ' 恢复应用默认设置
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
    
    Set removeDict = Nothing
    Set wsRemove = Nothing
End Sub

优化方案2：AutoFilter批量删除（超大数据量首选） #

如果目标工作表数据量极大，用AutoFilter批量删除可见行的效率会更高：

Sub RemoveUnits_AutoFilter()
    Dim wsRemove As Worksheet, wsTarget As Worksheet
    Dim removeLastRow As Long, targetLastRow As Long
    Dim filterArray As Variant
    Dim targetSheets As Variant
    
    targetSheets = Array("BARWON", "Sheet2", "Sheet3", "Sheet4", "Sheet5")
    Set wsRemove = ThisWorkbook.Worksheets("RemoveUnits")
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    ' 将待删除值转成数组，用于筛选
    removeLastRow = wsRemove.Cells(wsRemove.Rows.Count, "A").End(xlUp).Row
    filterArray = wsRemove.Range("A1:A" & removeLastRow).Value
    
    ' 循环处理每个目标工作表
    For Each wsTarget In ThisWorkbook.Worksheets(targetSheets)
        targetLastRow = wsTarget.Cells(wsTarget.Rows.Count, "C").End(xlUp).Row
        If targetLastRow >= 3 Then
            ' 以C2为表头启动筛选
            wsTarget.Range("C2:C" & targetLastRow).AutoFilter Field:=1, Criteria1:=filterArray, Operator:=xlFilterValues
            ' 删除筛选出的可见行（跳过表头行）
            On Error Resume Next ' 兼容无匹配行的情况
            wsTarget.Range("C3:C" & targetLastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
            On Error GoTo 0
            ' 取消筛选
            wsTarget.AutoFilterMode = False
        End If
    Next wsTarget
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub

内容的提问来源于stack exchange，提问作者Geoff De Ross