Question

我有一个基于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)

这是会计账簿中的预付款，附有参考编号/描述和金额，并且还添加了最后一栏中所需的调整或操作类型。

当doc＃相同且金额总和为零时，我需要突出显示两行，然后转到名为＆＃34;补偿项目＆＃34;，

的工作表

一些细节

我隐藏了一些不需要的列，如月/ abs / comments / adjusmtents。
标题栏是：
日期：A
类型：D
Doc＃：E
描述：F
金额：G
调整：J
- 此外，我可以获得与应收款相匹配的银行信贷。
- 如果只有金额净额为零，我也可以匹配，因为有些银行没有提供好的参考资料或doc＃匹配。

根据我迄今为止编写的代码来补偿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将影响＆＃34;否定＆＃34;变量

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.宏如果它们的总和为零，则突出显示前两项（当＃34;正面＆＃34;＆＃34;负面＆＃34;变量净零时效果非常好），然后是宏将项目移动到＆＃34;补偿＆＃34;成功完成工作表并将其从＆＃34;待处理项目＆＃34;中删除表（不再需要它们）。

2.第二个宏在＆＃34;肯定＆＃34;和＆＃34;否定＆＃34;变量不归零，然后宏将寻找下一个变量＆＃34;负＆＃34;变量到净值为零＆＃34;正面＆＃34;变量

我需要的是移动变量的代码＆＃34;肯定＆＃34;当变量＆＃34;否定＆＃34;到达最后一行（因为它没有匹配它，如果变量转到第二行重新进行处理，那就好了）在其他情况下，我需要Do Loops尽可能多的行...和不是意图。

如果你可以帮我减少代码并修复宏会很棒......我在VBA上只有3个月的智慧。

Answer 1

我将算法拆分为这样。

用户突出显示用于分组数据的列;在你的情况下，doc＃
VBA按此列对数据进行排序，这会导致相邻行显示相似数据
VBA逐步遍历行，查看组列以了解更改。当它找到更改时，它会启动一个新组。如果找不到更改，则会扩展现有组以包含当前行。
VBA适用＆＃39;条件＆＃39;每个小组。条件可能是＆＃34;列（5）的所有内容（对于特定组）是否/加到零？＆＃34;。条件结果以“是”或“否”存储在新列中。可以定义任何数量的条件以适应新列。
一旦计算并应用了条件数据，您就可以将所有化妆品作为单独的通行证 - 将原始数据保存在一个地方可能更好，并且复制“提取”＃39;如果您想稍后重新运行对帐，请转到不同的电子表格。

这样写它的好处是，步骤1,2和3可以重复用于将来你必须做的几乎任何和解。为第4部分和第5部分编写一些代码可能是特定于你的rec，但如果你这样写，你应该可以用作未来recs的模板。

VBA创建一个宏来匹配银行对帐中的项目 - 付款预订/银行借记

1 个答案: