Excel VBA创建宏以匹配银行对账-付款记账/银行借记中的项目

我有一个基于excel的银行对账，我正在使用ABS或条件格式进行手动匹配，如下面的示例，但我需要使用宏进行更快的匹配

这是银行对账的格式

                          HSBC BANK RECONCILIATION      
Date   Ref  Type         Doc#       Description                Amount           

03/31   1   Payment      991893     FUNDING GFR 2423           3.000.000,00

03/22   2   Bank Debit   991893     International Payment      (3.000.000,00)

这是在会计账簿中登记的付款，带有参考编号/说明和金额，并在最后一列中添加了所需的调整或行动类型

当两个单据相同且净额总和为零时，我需要突出显示两行，然后移动到称为“补偿项目”的工作表

一些细节

我隐藏了一些不需要的列，如month/abs/comments/adjustments

标题列包括：

日期：A

类型：D

医生：E

说明：F

金额：G

调整：J

此外，我可以有一个银行信贷，应该匹配的应收账款

我也可以匹配，只要金额净额为零，因为一些银行没有提供良好的参考或单据匹配

以下是我迄今为止为补偿ABS项目而制定的代码：

Sub CompensationMacro2()

'Automated Bank Reconciliation Process'
'**********************************'
'****Made by Juan Martin Castro****'
'**********************************'
'-------------------------------------------------------------'
'VBA Code to compensate Items 80% Functional
'VBA Code to Move items to Compensation tab 100% functional
'Improvements to add later:
'Accruals
'Bank Charges
'Fundings
'Reclass
'JE's that shouldn't be in the rec
'Add First Macro of Compensation code
'InputBox Bank Rec period linked to the "Summary" sheet
'-------------------------------------------------------------'

Dim positive As Currency
Dim negative As Currency
Dim positive As Long
Dim negative As Long
Dim i As Integer
Dim m As Integer
Dim o As Integer


i = 1
LastRow = Cells(20000, 6).End(xlUp).Row
m = 1
o = 2

Range("G2").Select

Do

Application.DisplayAlerts = False

positive = Cells(2, 7).Offset(m, 0).Value
negative = Cells(2, 7).Offset(o, 0).Value
positiveRow = Cells(2, 7).Offset(m, 0).Row
negativeRow = Cells(2, 7).Offset(o, 0).Row

If positive + negative = 0 Then

'Highlight compensated items

Cells(positiveRow, 7).Interior.Color = rgbLightBlue
Cells(negativeRow, 7).Interior.Color = rgbLightBlue
Cells(positiveRow, 7).Offset(0, 2).Value = "Compensated"
Cells(negativeRow, 7).Offset(0, 2).Value = "Compensated"

'Filter by Color
ActiveSheet.Range("$A$2:$N$25").AutoFilter Field:=7, Criteria1:=RGB(173, _
    216, 230), Operator:=xlFilterCellColor

'Select Range

Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select

'Copy to the "Compensated" sheet

Selection.Copy
Sheets("Compensated").Select
Cells(20000, 1).End(xlUp).Offset(2, 0).Select
ActiveSheet.Paste
Sheets("Pending Items").Select

'Delete Lines from "Pending Items" sheet

Range("A2").Offset(1, 0).Delete
Range("A2").Offset(1, 0).Delete

ActiveSheet.ShowAllData

'm = m + 1

Else

' Call Next loop

Call SecondItinerationSearchForCompensation

End If

'o = o + 1

    Loop Until negativeRow >= LastRow

    Application.DisplayAlerts = False

'Compensated Items Counting - add ID VBA code to make it work

        CompensatedItems = Sheets("Compensated").Cells(20000, 15).End(xlUp).Value

        MsgBox CompensatedItems & " Transactions Compensated", Title:="Bank Reconciliation Process (JMC)"


End Sub

这是第二个宏，它将执行几乎相同的操作，只需移动一个变量O=O+1，它将影响负变量

Sub SecondItinerationSearchForCompensation()

Dim CompensatedItems As Currency
m = 1
o = 2
LastRow = Cells(20000, 6).End(xlUp).Row

        Do
        LastRow = Cells(20000, 6).End(xlUp).Row
        Application.DisplayAlerts = False

        positive = Cells(2, 7).Offset(m, 0).Value
        negative = Cells(2, 7).Offset(o, 0).Value
        positiveRow = Cells(2, 7).Offset(m, 0).Row
        negativeRow = Cells(2, 7).Offset(o, 0).Row

        If positive + negative = 0 Then

'Highlight Compensated Items

        Cells(positiveRow, 7).Interior.Color = rgbLightBlue
        Cells(negativeRow, 7).Interior.Color = rgbLightBlue
        Cells(positiveRow, 7).Offset(0, 2).Value = "Compensated"
        Cells(negativeRow, 7).Offset(0, 2).Value = "Compensated"

'Filter by Color

        ActiveSheet.Range("$A$2:$N$25").AutoFilter Field:=7, Criteria1:=RGB(173, _
            216, 230), Operator:=xlFilterCellColor

'Select Range

        Range("A2").Select
        Range(Selection, Selection.End(xlToRight)).Select
        Range(Selection, Selection.End(xlDown)).Select

'Copy to the "Compensated" Sheet

        Selection.Copy
        Sheets("Compensated").Select
        Cells(20000, 1).End(xlUp).Offset(2, 0).Select
        ActiveSheet.Paste
        Sheets("Pending Items").Select

'Delete Lines from "Pending Items" sheet

        Range("A" & positiveRow).Delete
        Range("A" & (negativeRow) - 1).Delete

        ActiveSheet.ShowAllData

        o = 1

        Else

'Last Loop should be add to move from m position

         'm = m + 1 check where I should add this 

        End If

        o = o + 1

'It's where the macro will compensate - should be "positive" variable as it it the first amount checked from the top

        Loop Until negativeRow >= LastRow

    Application.DisplayAlerts = False

    'Compensated Items Counting - add Counter Items "ID" code to make it work


    CompensatedItems = Sheets("Compensated").Cells(20000, 15).End(xlUp).Value

    MsgBox CompensatedItems & " Transactions Compensated - Please Check Compensated Sheet", Title:="Bank Reconciliation Process (JMC)"

    End Sub

1.如果前两个项目的总和为零，则宏将突出显示前两个项目，这在正负变量净为零时效果非常好，然后宏成功地将项目移动到补偿表中，并将其从暂挂项目表中删除，不再需要它们

2.第二个宏在正负变量不求和为零时工作，然后宏将查找下一个负变量，以将正变量净为零

Sub SecondItinerationSearchForCompensation()

Dim CompensatedItems As Currency
m = 1
o = 2
LastRow = Cells(20000, 6).End(xlUp).Row

        Do
        LastRow = Cells(20000, 6).End(xlUp).Row
        Application.DisplayAlerts = False

        positive = Cells(2, 7).Offset(m, 0).Value
        negative = Cells(2, 7).Offset(o, 0).Value
        positiveRow = Cells(2, 7).Offset(m, 0).Row
        negativeRow = Cells(2, 7).Offset(o, 0).Row

        If positive + negative = 0 Then

'Highlight Compensated Items

        Cells(positiveRow, 7).Interior.Color = rgbLightBlue
        Cells(negativeRow, 7).Interior.Color = rgbLightBlue
        Cells(positiveRow, 7).Offset(0, 2).Value = "Compensated"
        Cells(negativeRow, 7).Offset(0, 2).Value = "Compensated"

'Filter by Color

        ActiveSheet.Range("$A$2:$N$25").AutoFilter Field:=7, Criteria1:=RGB(173, _
            216, 230), Operator:=xlFilterCellColor

'Select Range

        Range("A2").Select
        Range(Selection, Selection.End(xlToRight)).Select
        Range(Selection, Selection.End(xlDown)).Select

'Copy to the "Compensated" Sheet

        Selection.Copy
        Sheets("Compensated").Select
        Cells(20000, 1).End(xlUp).Offset(2, 0).Select
        ActiveSheet.Paste
        Sheets("Pending Items").Select

'Delete Lines from "Pending Items" sheet

        Range("A" & positiveRow).Delete
        Range("A" & (negativeRow) - 1).Delete

        ActiveSheet.ShowAllData

        o = 1

        Else

'Last Loop should be add to move from m position

         'm = m + 1 check where I should add this 

        End If

        o = o + 1

'It's where the macro will compensate - should be "positive" variable as it it the first amount checked from the top

        Loop Until negativeRow >= LastRow

    Application.DisplayAlerts = False

    'Compensated Items Counting - add Counter Items "ID" code to make it work


    CompensatedItems = Sheets("Compensated").Cells(20000, 15).End(xlUp).Value

    MsgBox CompensatedItems & " Transactions Compensated - Please Check Compensated Sheet", Title:="Bank Reconciliation Process (JMC)"

    End Sub

我需要的是当变量负数到达最后一行时移动变量正数的代码，因为它没有匹配项。如果变量转到第二行重新执行过程就可以了。在其他情况下，我需要尽可能多地执行循环行。。这并不是目的

---

如果你能帮我减少代码和修复宏将是伟大的。。。我在VBA上只学了3个月。

我会像这样把算法分解

用户突出显示用于分组数据的列；就你而言，博士 VBA按此列对数据进行排序，这会导致类似的数据出现在相邻行中 VBA逐行浏览，查看“组”列中的更改。当它发现一个更改时，它将启动一个新组。如果未发现任何更改，则会扩展现有组以包括当前行。 VBA将“条件”应用于每个组。一个条件可能是将特定组网络的第5列的所有内容都添加到零？。条件结果以“是”或“否”的形式存储在新列中。可以定义任意数量的条件以适应新列。 一旦计算并应用了条件数据，您就可以将所有的修饰工作作为一个单独的过程来完成——最好将原始数据保存在一个地方，并将“摘录”复制到不同的电子表格中，以防您以后要重新运行对帐。 这样写的好处是，步骤1、2和3可以重复使用，以便将来进行任何对账。 为第4部分和第5部分编写一些代码可能是特定于您的rec的，但是如果您这样编写的话，您应该能够将其用作未来rec的模板