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

h43kikqp  于 2022-12-24  发布在  其他
关注(0)|答案(1)|浏览(290)

我有一个基于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智慧。

crcmnpdw

crcmnpdw1#

我把算法分解成这样。
1.用户突出显示用于分组数据的列;在您情况下,文档编号

  1. VBA按此列对数据进行排序,这会导致相似数据出现在相邻行中
  2. VBA遍历各行,查看组列中的更改。如果发现更改,则启动一个新组。如果未发现更改,则扩展现有组以包括当前行。
  3. VBA将“条件”应用于每个组。条件可以是“列(5)(对于特定组)的所有内容是否为净/加为零?"。条件结果以”是“或”否“形式存储在新列中。可以定义任意数量的条件以适合新列。
    1.一旦计算并应用了条件数据,您就可以将所有的装饰性工作作为单独的传递来完成--最好将原始数据保存在一个地方,并将“提取”复制到不同的电子表格中,以防您以后要重新运行对账。
    这样编写的好处是,步骤1、2和3可以重用于您将来要做的几乎任何协调工作。为第4部分和第5部分编写一些代码可能是特定于您的rec的,但如果您只是这样编写,您应该能够将其用作将来rec的模板。

相关问题