求Excel VBA代码：Credit交易触发时汇总前期Debit并完成对账

以下VBA代码可实现你需求的对账逻辑：遍历交易记录，遇到Credit交易时自动汇总此前未结清的Debit（上月应计利息）金额，按规则完成对账并标记结清状态，已结清的交易不会再参与后续对账。

代码说明 #

假设你的数据列规则：

• A列：交易日期
• B列：交易类型（Debit/Credit）
• C列：交易金额
  代码会自动在D列标记交易结清状态，E列输出对账结果，F列标注对应未结清日期。

Sub ReconcileDebitCredit()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim unClearedDebits As Collection
    Dim debitItem As Variant
    Dim totalUnCleared As Double
    Dim creditAmount As Double
    
    ' 指定目标工作表，替换为你的工作表名称
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 初始化集合存储未结清Debit（元素为数组：(日期, 金额)）
    Set unClearedDebits = New Collection
    
    ' 遍历交易行（第1行为表头）
    For i = 2 To lastRow
        Select Case UCase(ws.Cells(i, "B").Value)
            Case "DEBIT"
                ' 新增未结清Debit到集合
                unClearedDebits.Add Array(ws.Cells(i, "A").Value, ws.Cells(i, "C").Value)
                ws.Cells(i, "D").Value = "未结清"
                
            Case "CREDIT"
                creditAmount = ws.Cells(i, "C").Value
                totalUnCleared = 0
                
                ' 计算当前未结清Debit总额
                For Each debitItem In unClearedDebits
                    totalUnCleared = totalUnCleared + debitItem(1)
                Next debitItem
                
                ' 按规则处理对账
                If creditAmount >= totalUnCleared Then
                    ' Credit金额足够结清所有未结清Debit
                    ws.Cells(i, "E").Value = 0
                    ws.Cells(i, "F").Value = "全部结清"
                    
                    ' 标记所有Debit为已结清并清空集合
                    For Each debitItem In unClearedDebits
                        Dim matchRow As Long
                        On Error Resume Next
                        matchRow = ws.Columns("A").Find(debitItem(0), LookIn:=xlValues, LookAt:=xlWhole).Row
                        On Error GoTo 0
                        If matchRow > 0 Then ws.Cells(matchRow, "D").Value = "已结清"
                    Next debitItem
                    Set unClearedDebits = New Collection
                Else
                    ' Credit金额不足，部分结清
                    Dim remainingAmount As Double
                    remainingAmount = totalUnCleared - creditAmount
                    ws.Cells(i, "E").Value = remainingAmount
                    ws.Cells(i, "F").Value = unClearedDebits(1)(0) ' 取最早未结清日期
                    
                    ' 拆分已结清/未结清Debit，更新集合和标记
                    Dim tempCollection As Collection
                    Set tempCollection = New Collection
                    Dim currentClearAmount As Double
                    currentClearAmount = 0
                    
                    For Each debitItem In unClearedDebits
                        If currentClearAmount + debitItem(1) <= creditAmount Then
                            ' 该Debit完全结清
                            Dim clearRow As Long
                            On Error Resume Next
                            clearRow = ws.Columns("A").Find(debitItem(0), LookIn:=xlValues, LookAt:=xlWhole).Row
                            On Error GoTo 0
                            If clearRow > 0 Then ws.Cells(clearRow, "D").Value = "已结清"
                            currentClearAmount = currentClearAmount + debitItem(1)
                        Else
                            ' 该Debit部分结清，剩余金额存入新集合
                            tempCollection.Add Array(debitItem(0), debitItem(1) - (creditAmount - currentClearAmount))
                            Dim partialRow As Long
                            On Error Resume Next
                            partialRow = ws.Columns("A").Find(debitItem(0), LookIn:=xlValues, LookAt:=xlWhole).Row
                            On Error GoTo 0
                            If partialRow > 0 Then
                                ws.Cells(partialRow, "D").Value = "部分结清"
                                ws.Cells(partialRow, "C").Value = debitItem(1) - (creditAmount - currentClearAmount)
                            End If
                            currentClearAmount = creditAmount ' Credit金额已用尽
                        End If
                        If currentClearAmount >= creditAmount Then Exit For
                    Next debitItem
                    
                    Set unClearedDebits = tempCollection
                End If
        End Select
    Next i
    
    ' 输出最终剩余未结清Debit汇总（可选）
    If unClearedDebits.Count > 0 Then
        ws.Cells(lastRow + 1, "A").Value = "剩余未结清"
        totalUnCleared = 0
        For Each debitItem In unClearedDebits
            totalUnCleared = totalUnCleared + debitItem(1)
        Next debitItem
        ws.Cells(lastRow + 1, "E").Value = totalUnCleared
        ws.Cells(lastRow + 1, "F").Value = unClearedDebits(1)(0)
    End If
    
    MsgBox "对账完成！"
End Sub

使用步骤 #

1. 打开你的Excel文件，按Alt+F11打开VBA编辑器
2. 插入模块：右键点击工程窗口中的文件 -> 插入 -> 模块
3. 将上述代码粘贴到模块中
4. 修改代码中的Sheet1为你的实际工作表名称
5. 确保交易记录按日期升序排列（否则无法正确处理"此前未结清"的逻辑）
6. 按F5执行宏，或通过Excel"开发工具"选项卡中的"宏"按钮执行

注意事项 #

• 若交易金额存在正负值差异（比如Debit为负、Credit为正），需调整代码中的数值判断逻辑（例如添加Abs()函数取绝对值）
• 若存在相同日期的多笔Debit，代码会按记录顺序优先结清较早的条目
• 执行前建议备份数据，避免误操作导致数据丢失

内容的提问来源于stack exchange，提问作者Ahmed EL HAWARY