编写VBA代码：删除匹配A/B列且C列金额总和为零的行

Hi Salem, 针对你的需求，我写了一段VBA代码，能帮你自动找出并删除符合条件的行——也就是A列内容一致、B列内容一致，且两行C列金额总和为0的成对行，而且会重复检查直到整个工作表里没有这类行为止。

核心思路 #

1. 因为删除行后，后续行的位置会向上移动，所以我们采用从后往前遍历的方式，避免漏检；
2. 每找到一对符合条件的行，就删除它们，然后重新开始遍历（因为删除后可能新的成对行出现）；
3. 用Do...Loop循环控制整个检查过程，直到一轮遍历下来没有找到任何符合条件的行，就结束程序。

完整代码 #

Sub DeleteMatchingZeroSumRows()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long, j As Long
    Dim foundMatch As Boolean
    
    ' 设置要操作的工作表，这里用当前激活的工作表，你可以改成具体表名比如Sheet1
    Set ws = ActiveSheet
    
    ' 开启屏幕更新关闭，提升运行速度
    Application.ScreenUpdating = False
    
    Do
        foundMatch = False
        lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' 获取A列最后一行行号
        
        ' 从后往前遍历行，避免删除行后漏检
        For i = lastRow To 2 Step -1
            ' 遍历当前行之前的所有行，找匹配项
            For j = i - 1 To 1 Step -1
                ' 检查A列、B列是否匹配，且C列总和为0
                If ws.Cells(i, "A").Value = ws.Cells(j, "A").Value _
                    And ws.Cells(i, "B").Value = ws.Cells(j, "B").Value _
                    And (ws.Cells(i, "C").Value + ws.Cells(j, "C").Value) = 0 Then
                    
                    ' 删除这两行
                    ws.Rows(j & ":" & i).Delete
                    foundMatch = True ' 标记找到匹配项，需要重新遍历
                    Exit For ' 退出内层循环，开始下一轮检查
                End If
            Next j
            If foundMatch Then Exit For ' 找到匹配项后退出外层循环，重新开始遍历
        Next i
    Loop While foundMatch ' 只要找到过匹配项，就重复检查
    
    ' 恢复屏幕更新
    Application.ScreenUpdating = True
    MsgBox "已完成所有符合条件行的删除！", vbInformation
End Sub

使用说明 #

1. 打开你的Excel文件，按下Alt + F11打开VBA编辑器；
2. 插入一个新模块（右键点击工作簿名称 -> 插入 -> 模块）；
3. 将上面的代码粘贴到模块中；
4. 回到Excel，按下Alt + F8选择DeleteMatchingZeroSumRows宏并执行。

注意事项 #

• 先备份数据！ 删除操作是不可逆的，建议先复制一份文件再运行宏；
• 如果你的数据量非常大（比如几万行），这段双层循环的代码可能会有点慢，这时可以考虑先把数据读到数组中进行匹配，再批量删除，效率会更高；
• 代码中默认操作当前激活的工作表，如果你需要指定特定工作表，把Set ws = ActiveSheet改成Set ws = ThisWorkbook.Worksheets("你的工作表名称")即可。

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