如何在Excel中自动化删除相互抵消的Saldo值的完整流程？

以下是完全自动化的VBA代码，可实现你需要的从创建绝对值列到重复执行筛选删除的完整流程，无需手动操作：

Sub DeleteOffsettingSaldoValues()
    Dim ws As Worksheet
    Dim saldoCol As Integer
    Dim lastRow As Long
    Dim absCol As Integer, check1Col As Integer, check2Col As Integer, finalCol As Integer
    Dim hasDelete As Boolean
    
    ' 设置当前工作表（可修改为指定表名，比如Set ws = ThisWorkbook.Worksheets("Sheet1")）
    Set ws = ActiveSheet
    
    ' 关闭屏幕更新，提升运行速度
    Application.ScreenUpdating = False
    
    On Error GoTo Cleanup ' 出错时恢复设置
    
    ' 找到saldo列（表头为"saldo"，不区分大小写）
    saldoCol = ws.Rows(1).Find(What:="saldo", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False).Column
    
    ' 获取数据最后一行
    lastRow = ws.Cells(ws.Rows.Count, saldoCol).End(xlUp).Row
    
    ' 1. 创建绝对值列
    absCol = saldoCol + 1
    ws.Cells(1, absCol).Value = "Abs_Saldo"
    ws.Range(ws.Cells(2, absCol), ws.Cells(lastRow, absCol)).Formula = "=ABS(" & ws.Cells(2, saldoCol).Address(False, False) & ")"
    ws.Calculate ' 计算绝对值
    
    Do
        hasDelete = False
        
        ' 2. 排序：先按saldo降序，再按绝对值列降序
        ws.Range(ws.Cells(1, saldoCol), ws.Cells(lastRow, absCol)).Sort _
            Key1:=ws.Cells(1, saldoCol), Order1:=xlDescending, _
            Key2:=ws.Cells(1, absCol), Order2:=xlDescending, _
            Header:=xlYes
        
        ' 更新最后一行（排序后可能有变化）
        lastRow = ws.Cells(ws.Rows.Count, saldoCol).End(xlUp).Row
        If lastRow < 2 Then Exit Do ' 无数据则退出
        
        ' 3. 创建三个辅助列并应用公式
        ' 列1: Check1
        check1Col = absCol + 1
        ws.Cells(1, check1Col).Value = "Check1"
        If lastRow >= 3 Then
            ws.Range(ws.Cells(3, check1Col), ws.Cells(lastRow, check1Col)).Formula = "=IF(" & ws.Cells(3, saldoCol).Address(False, False) & "+" & ws.Cells(4, saldoCol).Address(False, False) & "=0,""delete"",""ok"")"
        End If
        
        ' 列2: Check2
        check2Col = check1Col + 1
        ws.Cells(1, check2Col).Value = "Check2"
        If lastRow >= 3 Then
            ws.Range(ws.Cells(3, check2Col), ws.Cells(lastRow, check2Col)).Formula = "=IF(AND(" & ws.Cells(3, saldoCol).Address(False, False) & "<0," & ws.Cells(2, check1Col).Address(False, False) & "=""delete""),""delete"",""ok"")"
        End If
        
        ' 列3: Final_Check
        finalCol = check2Col + 1
        ws.Cells(1, finalCol).Value = "Final_Check"
        If lastRow >= 2 Then
            ws.Range(ws.Cells(2, finalCol), ws.Cells(lastRow, finalCol)).Formula = "=IF(OR(" & ws.Cells(2, check1Col).Address(False, False) & "=""delete""," & ws.Cells(2, check2Col).Address(False, False) & "=""delete""),""delete"",""ok"")"
        End If
        
        ws.Calculate ' 计算所有公式
        
        ' 检查是否有"delete"标记
        On Error Resume Next
        hasDelete = Not ws.Range(ws.Cells(2, finalCol), ws.Cells(lastRow, finalCol)).Find(What:="delete", LookIn:=xlValues, LookAt:=xlWhole) Is Nothing
        On Error GoTo Cleanup
        
        If hasDelete Then
            ' 4. 筛选并删除标记为"delete"的行
            ws.Range(ws.Cells(1, finalCol), ws.Cells(lastRow, finalCol)).AutoFilter Field:=1, Criteria1:="delete"
            ws.Range(ws.Cells(2, finalCol), ws.Cells(lastRow, finalCol)).SpecialCells(xlCellTypeVisible).EntireRow.Delete
            ws.AutoFilterMode = False ' 关闭筛选
            
            ' 更新最后一行
            lastRow = ws.Cells(ws.Rows.Count, saldoCol).End(xlUp).Row
        End If
        
    Loop While hasDelete ' 重复直到没有"delete"标记
    
    ' 删除所有辅助列
    ws.Columns(absCol & ":" & finalCol).Delete
    
Cleanup:
    ' 恢复屏幕更新
    Application.ScreenUpdating = True
    If Err.Number <> 0 Then
        MsgBox "运行出错: " & Err.Description, vbExclamation
    End If
End Sub

使用方法： #

1. 打开目标Excel文件，确保表头包含saldo列
2. 按下Alt + F11打开VBA编辑器
3. 在左侧"工程资源管理器"中右键点击工作簿 → 插入 → 模块
4. 将上述代码粘贴到模块窗口
5. 按下F5运行宏，或回到Excel界面点击"开发工具"→"宏"→选择DeleteOffsettingSaldoValues执行

代码说明： #

• 自动定位saldo列，无需手动指定列号
• 循环执行排序、公式计算、筛选删除操作，直到无抵消行
• 自动清理辅助列，仅保留原始数据和saldo列
• 包含错误处理，出错时提示并恢复Excel设置

内容的提问来源于stack exchange，提问作者Manuel Cunha Rocha