VBA 創建一個宏以匹配銀行對帳中的項目 - 付款預訂/銀行借記

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# 相同並且凈額總和為零時，我需要突出顯示這兩行，然后移動到名為“補償項目”的工作表，

一些細節

• 我隱藏了一些不需要的列，如月/絕對/評論/調整。

• 標題欄是：

• 日期：A

• 類型：D

• 文檔#：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，這將影響“負”變量。

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.當“正”和“負”變量的總和不為零時，第二個宏起作用，然后宏將尋找“負”變量的下一個變量，以將“正”變量凈為零。

我需要的是當變量“負”到達最后一行時移動變量“正”的代碼（因為它沒有匹配，如果變量轉到第二行重新執行過程就可以了）在其他情況下我'將需要 Do Loops 與我擁有的行數一樣多……這不是我的意圖。

如果您能幫助我減少代碼並修復宏，那就太好了……我只有 3 個月的 VBA 知識。

Answer 1

我會像這樣拆分算法。

1. 用戶突出顯示用於分組數據的列； 在你的情況下，文檔#
2. VBA 按此列對數據進行排序，這會導致相似數據出現在相鄰行中
3. VBA 逐行瀏覽，查看組列中的更改。 當它發現變化時，它會啟動一個新組。 如果發現沒有變化，它會擴展現有組以包括當前行。
4. VBA 將“條件”應用於每個組。 條件可能是“列（5）的所有內容（對於特定組）凈/加為零嗎？”。 條件結果作為 Yes 或 No 存儲在新列中。可以定義任意數量的條件以適合新列。
5. 一旦計算並應用了條件數據，您就可以將所有裝飾性的東西作為一個單獨的通道來完成——最好將原始數據保存在一個地方，並將“提取物”復制到不同的電子表格中，以防您想重新運行以后和解。

像這樣編寫它的好處是步驟 1、2 和 3 幾乎可以重復用於您將來必須進行的任何對帳。 為第 4 部分和第 5 部分編寫一些代碼可能特定於您的 rec，但如果您只是這樣編寫，您應該能夠用作未來 rec 的模板。