Excel VBA：删除含指定字符串行及对应关联内容的所有行

数据场景 #

现有Excel工作表数据结构如下：

需求说明 #

• 删除所有C列包含BAD1、BAD2、BAD3的行；
• 若某A列内容对应的任意行中C列出现上述BAD字符串，删除该A列内容对应的所有行（例如data4因某行C列含BAD2，需删除所有data4的行）。

现有尝试代码（无法实现关联删除） #

Sub DeleteBAD()
  Dim v As Variant
  For Each v In Array("BAD1", "BAD2")
    Columns("F").Replace v, "#N/A", xlWhole, , True, , False, False
  Next
  Columns("F").SpecialCells(xlConstants, xlErrors).EntireRow.Delete
End Sub

可行VBA解决方案 #

以下代码先标记所有需要删除的A列内容，再批量删除对应行，避免遗漏关联数据：

Sub DeleteBadAssociatedRows()
    Dim ws As Worksheet
    Dim badValues As Variant
    Dim badKeys As Object
    Dim lastRow As Long
    Dim i As Long
    
    ' 设置目标工作表（可根据实际修改为Sheet1等）
    Set ws = ThisWorkbook.ActiveSheet
    ' 定义需要匹配的BAD值集合
    badValues = Array("BAD1", "BAD2", "BAD3")
    ' 创建字典存储需删除的A列内容（避免重复）
    Set badKeys = CreateObject("Scripting.Dictionary")
    
    ' 第一步：遍历所有行，收集关联BAD值的A列内容
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    For i = lastRow To 1 Step -1
        For Each val In badValues
            ' 精准匹配C列的BAD值（如需模糊匹配，可改为InStr(ws.Cells(i,"C").Value, val) > 0）
            If ws.Cells(i, "C").Value = val Then
                If Not badKeys.Exists(ws.Cells(i, "A").Value) Then
                    badKeys.Add ws.Cells(i, "A").Value, True
                End If
                Exit For ' 找到匹配值后跳出内层循环
            End If
        Next val
    Next i
    
    ' 第二步：遍历所有行，删除A列内容在字典中的行
    For i = lastRow To 1 Step -1
        If badKeys.Exists(ws.Cells(i, "A").Value) Then
            ws.Rows(i).Delete
        End If
    Next i
    
    ' 释放对象资源
    Set badKeys = Nothing
    Set ws = Nothing
End Sub

代码说明 #

1. 字典去重存储：通过字典记录所有关联BAD值的A列内容，确保每个A列值只被标记一次；
2. 倒序遍历删除：从最后一行往前删除，避免因行号变动导致遗漏数据；
3. 可灵活调整匹配规则：若需要模糊匹配C列中包含BAD的内容，将判断条件改为InStr(ws.Cells(i, "C").Value, val) > 0即可。

使用注意事项 #

• 若数据包含表头，需将循环起始行改为2（跳过表头行）；
• 运行前建议备份数据，避免误删；
• 确保Excel已启用脚本字典（默认支持，无需额外配置）。

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