我有一个基于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)
这是在会计账簿中登记的付款,带有参考编号/描述和金额,还在最后一栏中添加了所需的调整或操作类型。
我需要突出显示两行时,两个文件号是相同的,金额净额为零的总和,然后移动到一个工作表称为"补偿项目",
一些细节
- 我隐藏了一些不需要的列,如月份/abs/comments/adjusmtents。
- 标题列为:
- 日期: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.第二个宏在"正"和"负"变量之和不为零时工作,然后宏将寻找"负"变量的下一个变量,以使"正"变量归零。
我需要的是代码移动变量"积极"时,变量"消极"到达最后一行(因为它没有匹配,如果变量到第二行重新做的过程是确定的)在其他情况下,我需要做循环尽可能多的行,因为我有..这不是目的.
如果你能帮我减少代码和修复宏将是伟大的...我只是3个月的VBA智慧。
1条答案
按热度按时间crcmnpdw1#
我把算法分解成这样。
1.用户突出显示用于分组数据的列;在您情况下,文档编号
1.一旦计算并应用了条件数据,您就可以将所有的装饰性工作作为单独的传递来完成--最好将原始数据保存在一个地方,并将“提取”复制到不同的电子表格中,以防您以后要重新运行对账。
这样编写的好处是,步骤1、2和3可以重用于您将来要做的几乎任何协调工作。为第4部分和第5部分编写一些代码可能是特定于您的rec的,但如果您只是这样编写,您应该能够将其用作将来rec的模板。