如何修改VBA代码实现跨工作表删除指定填充色的行

原代码问题分析 #

1. 原DeleteColourLoop宏中，循环遍历所有工作表但始终使用ActiveSheet处理，导致仅能操作当前激活的工作表，无法覆盖所有目标表。
2. 逐行逐列检查并删除的方式效率极低，数据量大时会因频繁触发工作表布局调整而卡顿。
3. Repeater宏重复调用DeleteColourLoop会多次弹出颜色选择框，操作冗余。

优化方案1：仅选择一次颜色，跨所有工作表删除 #

该版本只需手动选择一次目标颜色单元格，即可批量处理所有工作表：

Sub DeleteColoredRowsAcrossSheets()
    Dim targetColor As Long
    Dim rngSample As Range
    Dim ws As Worksheet
    Dim rowsToDelete As Range
    Dim cell As Range
    
    ' 仅选择一次目标颜色单元格
    On Error Resume Next
    Set rngSample = Application.InputBox( _
        Prompt:="选择一个带有要删除背景色的单元格", _
        Title:="批量删除有色行", Type:=8)
    On Error GoTo 0
    
    If rngSample Is Nothing Then
        MsgBox "操作已取消，处理终止。", vbInformation, "提示"
        Exit Sub
    End If
    targetColor = rngSample.Interior.Color
    
    ' 关闭屏幕刷新和自动计算提升效率
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    For Each ws In ThisWorkbook.Worksheets
        Set rowsToDelete = Nothing
        ' 遍历当前工作表已用区域，收集需删除的行
        For Each cell In ws.UsedRange
            If cell.Interior.Color = targetColor Then
                If rowsToDelete Is Nothing Then
                    Set rowsToDelete = cell.EntireRow
                Else
                    Set rowsToDelete = Union(rowsToDelete, cell.EntireRow)
                End If
            End If
        Next cell
        
        ' 一次性删除所有目标行，避免逐行删除的低效
        If Not rowsToDelete Is Nothing Then
            rowsToDelete.Delete
        End If
    Next ws
    
    ' 恢复默认设置
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    MsgBox "所有工作表中对应颜色的行已删除完毕。", vbInformation, "完成"
End Sub

优化方案2：直接指定RGB值，无需选择单元格 #

适合需重复处理同一种颜色的场景，直接在代码中定义目标颜色的RGB值即可：

Sub DeleteRowsByRGBColor()
    Dim targetRGB As Long
    Dim ws As Worksheet
    Dim rowsToDelete As Range
    Dim cell As Range
    
    ' 直接指定目标颜色的RGB值，示例为红色，可按需修改
    targetRGB = RGB(255, 0, 0)
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    For Each ws In ThisWorkbook.Worksheets
        Set rowsToDelete = Nothing
        For Each cell In ws.UsedRange
            If cell.Interior.Color = targetRGB Then
                If rowsToDelete Is Nothing Then
                    Set rowsToDelete = cell.EntireRow
                Else
                    Set rowsToDelete = Union(rowsToDelete, cell.EntireRow)
                End If
            End If
        Next cell
        
        If Not rowsToDelete Is Nothing Then
            rowsToDelete.Delete
        End If
    Next ws
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    MsgBox "所有工作表中指定RGB颜色的行已删除完毕。", vbInformation, "完成"
End Sub

注意事项 #

• 若工作表存在合并单元格，UsedRange可能包含冗余区域，可将遍历范围改为特定列（例如ws.Range("A1:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)）以精准处理。
• 执行前建议备份工作簿，避免误删数据。

内容的提问来源于stack exchange，提问作者LBTwin