如何修改VBA代码实现多工作表按单元格值批量删除行

调整后的完整代码 #

Sub RectangleRoundedCorners10_Click()
    Dim ws As Worksheet
    Dim targetSheets As Variant
    Dim rng As Range
    Dim foundCell As Range
    Dim deleteRows As Range
    
    ' 定义需要处理的三个工作表
    targetSheets = Array(Sheet1, Sheet2, Sheet3)
    
    ' 遍历每个目标工作表
    For Each ws In targetSheets
        ' 定位当前工作表的目标区域（A9到ZZ2000）
        Set rng = ws.Range("A9:ZZ2000")
        Set deleteRows = Nothing
        
        ' 查找第一个包含"Delete"开头的单元格
        Set foundCell = rng.Find(What:="Delete*", LookIn:=xlValues, LookAt:=xlPart)
        
        ' 循环收集所有匹配的行
        Do While Not foundCell Is Nothing
            If deleteRows Is Nothing Then
                Set deleteRows = foundCell.EntireRow
            Else
                Set deleteRows = Union(deleteRows, foundCell.EntireRow)
            End If
            ' 查找下一个匹配项，避免重复处理
            Set foundCell = rng.FindNext(foundCell)
        Loop
        
        ' 批量删除所有匹配行（如果存在）
        If Not deleteRows Is Nothing Then
            deleteRows.Delete
        End If
    Next ws
End Sub

关键改动说明 #

• 新增多工作表遍历逻辑：通过Array(Sheet1, Sheet2, Sheet3)指定要处理的工作表，用For Each循环逐个处理
• 优化删除逻辑：先收集所有需要删除的行，再一次性批量删除，避免原代码中逐行删除导致的查找遗漏问题，同时提升执行效率
• 修复无效代码：移除原代码中多余的Next ws语句
• 精准查找控制：使用FindNext确保遍历所有匹配单元格，不会因为行删除导致跳过内容

可选调整项 #

• 如果需要按工作表标签名称（而非代码名称）指定目标表，可将targetSheets的定义改为：

  targetSheets = Array(ThisWorkbook.Worksheets("Sheet1"), ThisWorkbook.Worksheets("Sheet2"), ThisWorkbook.Worksheets("Sheet3"))
  

• 若要匹配包含"Delete"任意位置的文本，将Find中的What:="Delete*"改为What:="*Delete*"
• 可根据实际数据范围调整ws.Range("A9:ZZ2000")，缩小范围能提升运行速度

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