Консолидировать данные в разрезе контрагентов, как макросом? - VBA

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

Уважаемые спецы! Прошу помощи.Есть исходный формат отчета, как возможно консолидировать данные в разрезе контрагентов? Контрагентов может быть до 200, да и по каждой реализации - возможен разный размер номенклатуры.

Решение задачи: «Консолидировать данные в разрезе контрагентов, как макросом?»

textual
                            Листинг программы 
                        
 
                        
                          
                    
Sub konsolidazija()
    Dim r, m(), rz(), nam, u
    Dim sp: Set sp = CreateObject("Scripting.Dictionary")
    Dim sz: Set sz = CreateObject("Scripting.Dictionary")
    Dim sm: Set sm = CreateObject("Scripting.Dictionary")
    With Лист1
        m = .[a1].Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, 4).Value
        For r = 3 To UBound(m)
            If Not IsNumeric(m(r, 2)) Then ' если не цифра
                nam = m(r, 2)
            Else
                sp(nam) = sp(nam) + m(r, 2)
                sz(nam) = sz(nam) + m(r, 3)
                sm(nam) = sm(nam) + m(r, 4)
            End If
        Next r
        u = sp.keys
        ReDim rz(1 To sp.Count, 1 To 4)
        For r = 0 To UBound(u)
            rz(r + 1, 1) = u(r)
            rz(r + 1, 2) = sp(u(r))
            rz(r + 1, 3) = sz(u(r))
            rz(r + 1, 4) = sm(u(r))
        Next r
        .[g3].Resize(UBound(rz), UBound(rz, 2)) = rz
    End With
End Sub