Форматирование таблиц

[Serg]

Добрый день

Прошу помощи в решении след. задачи.
Есть сводная табл. из которой берутся данные (лист сводная) и есть таблица отчета. Необходимо данные перенести из сводной в отчетную табл. данные по группам (сумма и количество адресов). Сложность в том что сводная табл. не всегда одинакова формат тот же, а столбцов меньше(нет в продажи колбасы, её и в табл. нет). Бывает что в ней отсутствует тот или иной столбец.

[iron priest]

ну так вы бы и приложили сводную таблицу, а не набор данных

[Hugo121]

Всё можно сделать одной функцией (в D4 и E4)

Код Выделить Развернуть

=СУММПРОИЗВ((Сводная!$B$3:$B$16=Отчет!A4)*(Сводная!$C$2:$L$2=Отчет!$D$2)*Сводная!$C$3:$L$16)

Код Выделить Развернуть

=СУММПРОИЗВ((Сводная!$B$3:$B$16=Отчет!A4)*(Сводная!$C$2:$L$2=Отчет!$D$2)*(Сводная!C3:L16>0))
Ну а макросом - словари рулят. Но сейчас некогда.

[Hugo121]

Словари-массивы:

Код Выделить Развернуть

Option Explicit

Sub tt()
    Dim a(), aDic As Object, bDic As Object, i&, ii&, t$

    Set aDic = CreateObject("Scripting.Dictionary"): aDic.comparemode = 1
    Set bDic = CreateObject("Scripting.Dictionary"): bDic.comparemode = 1

    a = Sheets("Сводная").[a2].CurrentRegion.Value
    For i = 2 To UBound(a)

        For ii = 3 To UBound(a, 2)
            t = a(i, 2) & "|" & a(1, ii)
            bDic.Item(t) = bDic.Item(t) + a(i, ii)
            If a(i, ii) > 0 Then aDic.Item(t) = aDic.Item(t) + 1
        Next
    Next

    a = Sheets("Отчет").[a2].CurrentRegion.Value
    For i = 3 To UBound(a)
        For ii = 2 To UBound(a, 2) - 1 Step 2
            t = a(i, 1) & "|" & a(1, ii)
            a(i, ii) = bDic.Item(t)
            a(i, ii + 1) = aDic.Item(t)
        Next
    Next
   
    Sheets("Отчет").[a2].CurrentRegion.Value = a

End Sub

Остались "непонятки" с Итого - всё решаемо, но это Вам решать.