Расчет инструментами 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