Расчет инструментами BVA суммы долга по контрагентам с условиями - VBA

Формулировка задачи:

Помогите пожалуйста инструментами BVA решить такую задачу. Есть клиенты в таблице 1 в разрезе Фио, ИНН, сумма долга Есть клиенты в таблице 2 в разрезе Фио, Договор, ИНН, сумма долга Есть клиенты в таблице 3 в разрезе Фио, ИНН В таблице 4 нужно получить результат задачи. Задача. Нужно автоматически высчитать на листе «Таб4» таблицу с такими колонками «Фио», «ИНН», «сумма долга», «сумма к возврату», «причина отказа», «не выплачено» исходя с таких условий: 1) Долг меньше 1000 единиц НЕ отдаем 2) Всем клиентам в таблице 3 НЕ отдаем 3) Клиентам с суммой задолженности по всем договорам свыше 10000000 НЕ отдаем 4) Всем остальным ОТДАЕМ Пример и желаемый результат во вложении

Решение задачи: «Расчет инструментами BVA суммы долга по контрагентам с условиями»

textual
                            Листинг программы 
                        

                            Sub Таблица_возвратов()
    Dim i&, A, B, Dic1, Dic2, vX
    Set Dic1 = CreateObject("Scripting.Dictionary"): Dic1.CompareMode = 1
    Set Dic2 = CreateObject("Scripting.Dictionary"): Dic2.CompareMode = 1
    A = Worksheets("Таб1").[A1].CurrentRegion.Value
    For i = 2 To UBound(A)
        A(i, 1) = Trim(A(i, 1))
        A(i, 2) = Trim(A(i, 2))
        Dic1(A(i, 1) & A(i, 2)) = i
    Next i
    B = Worksheets("Таб3").[A1].CurrentRegion.Value
    For i = 2 To UBound(B)
        B(i, 1) = Trim(B(i, 1))
        B(i, 2) = Trim(B(i, 2))
        Dic2(B(i, 1) & B(i, 2)) = 0&
    Next i
    With Worksheets("Таб4")
        .UsedRange.Offset(1, 0).ClearContents
        i = 1
        For Each vX In Dic1.Keys
            i = i + 1
            .Cells(i, 1) = A(Dic1(vX), 1)
            .Cells(i, 2) = A(Dic1(vX), 2)
            .Cells(i, 3) = A(Dic1(vX), 3)
            .Cells(i, 4) = 0
            If Dic2.Exists(vX) Then
                .Cells(i, 5) = "Таб3"
            ElseIf .Cells(i, 3) > 10000000 Then
                .Cells(i, 4) = 10000000
            ElseIf .Cells(i, 3) < 1000 Then
                .Cells(i, 5) = "меньше 1000"
            Else
                .Cells(i, 4) = .Cells(i, 3)
            End If
            .Cells(i, 6).FormulaR1C1 = "=RC[-3]-RC[-2]"
        Next
        .[A1].CurrentRegion.Borders.LineStyle = xlContinuous
    End With
    Set Dic1 = Nothing: Set Dic2 = Nothing
End Sub
                        