Итоги в строках под данными excel vba

This can be accomplished with a simple SUBTOTAL across a dynamic range. Locating Total in column B can be looped.

Option Explicit

Sub totalAllClients()
    Dim rng As Range, rngsb As Range, addr As String

    With Worksheets("sheet11")
        With Intersect(.Columns(2), .UsedRange)
            Set rng = .Find(What:="total", After:=.Cells(1), MatchCase:=False, _
                            LookAt:=xlWhole, SearchDirection:=xlPrevious)
            If Not rng Is Nothing Then
                addr = rng.Address(0, 0)
                Do
                    rng.Offset(0, 1).FormulaR1C1 = _
                        "=index(c2, match(""zzz"", r1c2:r[-1]c2))"
                    rng.Offset(0, 3).Resize(, 6).FormulaR1C1 = _
                        "=subtotal(109, r[-1]c:index(c, match(""zzz"", r1c2:r[-1]c2)))"
                    Set rng = .FindNext(After:=rng)
                Loop Until rng.Address(0, 0) = addr

                rng.Offset(2, 3).Resize(1, 6).FormulaR1C1 = _
                    "=aggregate(9, 3, r2c:r" & rng.Row & "c)"
            End If
        End With
    End With

End Sub

MrSlonidze Пользователь Сообщений: 3 Регистрация: 16.01.2018

Приветствую! Нужен макрос, который будет вставлять функцию промежуточные итоги в уже созданную структуру диапазона данных. Искал на форуме ответ и самым похожим был макрос который считал уровни группировки, создавал ссылки на ячейки внутри группировок и суммировал их значения. Вот если бы к нему еще функцию промежуточные итоги добавить… Пример прилагается. То что хотелось бы видеть в итоге — на листе «желаемый результат» Прикрепленные файлы 1.xlsx (18.24 КБ) Изменено: MrSlonidze — 17.01.2018 11:34:37

a.i.mershik Пользователь Сообщений: 8277 Регистрация: 03.12.2015	#2 17.01.2018 10:56:52 MrSlonidze,а формула не подходит и протянуть по столбцам? Код =ПРОМЕЖУТОЧНЫЕ.ИТОГИ(9;B7:B48) Не бойтесь совершенства. Вам его не достичь.

MrSlonidze Пользователь Сообщений: 3 Регистрация: 16.01.2018

Это же формула для таблицы в целом, а нужно вставить в каждую группировку, по видам рыб, еще задать диапазон для каждой формулы, т. к. они разные. Для ячейки B6 это =ПРОМЕЖУТОЧНЫЕ.ИТОГИ(9;B7:B12), для ячейки B13 это =ПРОМЕЖУТОЧНЫЕ.ИТОГИ(9;B14:B22), для ячейки B16 это =ПРОМЕЖУТОЧНЫЕ.ИТОГИ(9;B17:B20) и т. д. Короче говоря, руками вводить долго. Тем более что приведенная таблица это только малая часть всей информации.

Z Пользователь Сообщений: 6111 Регистрация: 21.12.2012 Win 10, MSO 2013 SP1

#4 17.01.2018 11:33:23 Цитата MrSlonidze написал: Нужен макрос OFF Правила следует не просто читать, но и чтить… См. «2.7. Если вам нужен не совет по самостоятельному решению задачи, а чтобы все сделали за вас — добро пожаловать в ветку Работа . Там, скорее всего, найдутся специалисты, которые разберутся с вашей проблемой быстро, качественно и за разумную плату.» Изменено: Z — 17.01.2018 11:33:51 «Ctrl+S» — достойное завершение ваших гениальных мыслей!..

RAN Пользователь Сообщений: 7091 Регистрация: 21.12.2012

#5 17.01.2018 12:02:20 Цитата MrSlonidze написал: макрос который считал уровни группировки поможет вам как рыбе зонтик Код Sub qq()     Dim i&, ii&, k&     ii = Cells(Rows.Count, 1).End(xlUp).Row + 1     Rows(ii).Insert     For i = ii To 1 Step -1         If Cells(i, 1).Font.Bold = True Then             k = ii - i             Range("B" & ii & ":F" & ii).FormulaR1C1 = "=SUBTOTAL(109,R[-" & k & "]C:R[-1]C)"             Range("B" & ii & ":F" & ii).Font.Bold = True             Range("B" & ii & ":F" & ii).NumberFormat = "#,##0_ ;[Red]-#,##0"             If Rows(i - 1).OutlineLevel = 1 Then Exit Sub Else Rows(i).Insert             ii = i         End If     Next End Sub

MrSlonidze Пользователь Сообщений: 3 Регистрация: 16.01.2018	Код сработал отлично! Одно только уточнение: макрос создает новые строки и вставляет промежуточные итоги под группой, а надо бы над группой в ячейки залитые желтым. Как в примере. Что нужно поправить?

RAN Пользователь Сообщений: 7091 Регистрация: 21.12.2012	Все. Начиная с формулы, и кончая алгоритмом определения нужной строки

cuprum Пользователь Сообщений: 226 Регистрация: 26.02.2014	#8 17.01.2018 14:57:04 Взял на себя смелость модифицировать код уважаемого RAN, надеюсь он на меня не обидится. Код Sub zz()     Dim i&, ii&, k&     ii = Cells(Rows.Count, 1).End(xlUp).Row + 1     Rows(ii).Insert     For i = ii To 6 Step -1         If Cells(i, 1).Font.Bold = True Then             k = ii - i             Range("B" & i & ":F" & i).FormulaR1C1 = "=SUBTOTAL(109,R[1]C:R[" & k - 1 & "]C)"             Range("B" & i & ":F" & i).Font.Bold = True             Range("B" & i & ":F" & i).NumberFormat = "#,##0_ ;[Red]-#,##0"             ii = i         End If     Next End Sub Изменено: cuprum — 17.01.2018 14:59:31

Промежуточные итоги в таблице

Альбина Дата: Понедельник, 18.11.2013, 10:01 | Сообщение № 1 Группа: Пользователи Ранг: Новичок Сообщений: 23 Репутация: 7 ± Замечаний: 0% ± Здравствуйте уважаемые форумчане. Помогите пожалуйста написать макрос, подводящий промежуточные итоги в таблице. Есть заполненная таблица (файл прилагается). В ней уже подведены итоги по группам. Необходимо подсчитать промежуточный итог по позициям, в которых заполнено поле признак и в которых данное поле не заполнено. В прилагаемом файле на листе 1 имеющаяся таблица, на листе 2 — как должно быть. К сообщению приложен файл: 8358190.xls (26.5 Kb)   Ответить

ABC Дата: Понедельник, 18.11.2013, 11:42 | Сообщение № 2 Группа: Друзья Ранг: Обитатель Сообщений: 397 Репутация: 112 ± Замечаний: 0% ± Excel 2007 Здравствуйте, через сводную не пробовали? К сообщению приложен файл: 7320715.xls (31.0 Kb) MS Excel 2007 and 2010… ——————————- С Уважением, Даулет   Ответить

nilem Дата: Понедельник, 18.11.2013, 11:56 | Сообщение № 3 Группа: Авторы Ранг: Старожил Сообщений: 1612 Репутация: 563 ± Замечаний: 0% ± Excel 2013, 2016 или, например, «Данные» — «Пром. итог». Не подходит? Яндекс.Деньги 4100159601573   Ответить

Альбина Дата: Понедельник, 18.11.2013, 12:16 | Сообщение № 4 Группа: Пользователи Ранг: Новичок Сообщений: 23 Репутация: 7 ± Замечаний: 0% ± Нужен макрос, данные в таблицу загружаются программно, большой объем данных, хотелось бы, чтобы в момент выгрузки сработал VBA и бухгалтер видел промежуточный итог, не производя дополнительных действий. Понимаю, что возможно включить запись макроса и сделать операцию, подсказанную выше «Данные» — «Пром. итог». Тогда подскажите, какие столбцы нужно при этом выделить, потому что у меня подсчитывается итог по группе а не по признаку.   Ответить

AndreTM Дата: Понедельник, 18.11.2013, 12:25 | Сообщение № 5 Группа: Друзья Ранг: Старожил Сообщений: 1762 Репутация: 498 ± Замечаний: 0% ± 2003 & 2010 Можно сделать что-то типа такого: [vba] Код Sub test()      i = 2      cPriz = «~»            Do          If Cells(i, 1) & Cells(i, 2) <> cPriz And cPriz <> «~» Then              Rows(i).Insert              Cells(i, 1) = «Итого с признаком ‘» & Cells(i — 1, 2) & «‘:»              Cells(i, 1).Resize(, 3).Interior.ColorIndex = 40              Cells(i, 3) = nSum              Cells(i, 1).Resize(, 2).Merge              cPriz = «~»          Else              If cPriz = «~» Then                  nSum = 0                  If Left(Cells(i, 1), 5) <> «Итого» Then                      cPriz = Cells(i, 1) & Cells(i, 2)                  End If              End If              If Cells(i, 1) & Cells(i, 2) = cPriz Then                  nSum = nSum + Cells(i, 3)              End If          End If          i = i + 1      Loop Until Cells(i, 1) = «»        End Sub [/vba] Skype: andre.tm.007 Donate: Qiwi: 9517375010   Ответить

ABC Дата: Понедельник, 18.11.2013, 12:26 | Сообщение № 6 Группа: Друзья Ранг: Обитатель Сообщений: 397 Репутация: 112 ± Замечаний: 0% ± Excel 2007 так подойдет? [vba] Код Sub Test()      Dim arr(), arr2(), i&, y&, it, arr1      Application.ScreenUpdating = False      With Sheets(1)          arr = .Range(«A2:C» & .Cells(.Rows.Count, 1).End(xlUp).Row).Value      End With      With CreateObject(«Scripting.Dictionary»)          For i = LBound(arr, 1) To UBound(arr, 1)              If arr(i, 1) <> «Итого по группе 1:» Then                  it = arr(i, 1) & «@@» & arr(i, 2)                  .Item(it) = .Item(it) + arr(i, 3)              End If          Next i                    ReDim arr2(1 To .Count, 1 To 3)          y = 1          For Each it In .Keys              arr1 = Split(it, «@@»)              arr2(y, 1) = arr1(0)              arr2(y, 2) = arr1(1)              arr2(y, 3) = .Item(it)              y = y + 1          Next it      End With      With Sheets(3)          .Cells.Clear          .[a1].Resize(y — 1, 3).Value = arr2          .Activate      End With      Application.ScreenUpdating = True End Sub [/vba] MS Excel 2007 and 2010… ——————————- С Уважением, Даулет   Ответить

Альбина Дата: Понедельник, 18.11.2013, 13:07 | Сообщение № 7 Группа: Пользователи Ранг: Новичок Сообщений: 23 Репутация: 7 ± Замечаний: 0% ± Большое спасибо за ответы! AndreTM. Ваш макрос это именно то, что нужно! Только немного некорректно во второй группе прошел поиск признака ‘X’. Сразу после первой позиции группы 2 с признаком ‘X’ подвелся итог. В прикрепленном файле результат выполнения макроса. К сообщению приложен файл: 9327071.xls (43.0 Kb)   Ответить

Pelena Дата: Понедельник, 18.11.2013, 13:09 | Сообщение № 8 Группа: Админы Ранг: Местный житель Сообщений: 18797 Репутация: 4284 ± Замечаний: ± Excel 2016 & Mac Excel немного некорректно во второй группе прошел поиск признака ‘X’ У Вас данные некорректны: буква Х то русская, то латинская «Черт возьми, Холмс! Но как??!!» Ю-money 41001765434816   Ответить

Альбина Дата: Понедельник, 18.11.2013, 13:17 | Сообщение № 9 Группа: Пользователи Ранг: Новичок Сообщений: 23 Репутация: 7 ± Замечаний: 0% ± Да, вы правы, буквы у меня оказались разные. Все работает так, как мне было нужно! Огромное всем спасибо за помощь!   Ответить

Альбина Дата: Понедельник, 18.11.2013, 15:05 | Сообщение № 10 Группа: Пользователи Ранг: Новичок Сообщений: 23 Репутация: 7 ± Замечаний: 0% ± К сожалению не рассчитала свои силы, слишком упростила документ для примера. Если можно было бы вернуться к этой теме, помогите пожалуйста. Исходный файл осложнен тем, что в столбце «Группа» включено объединение ячеек и каждая новая группа отделяется строкой с именем этой группы. Можно ли обойти эти сложности? К сообщению приложен файл: 9031252.xls (45.5 Kb)   Ответить

AndreTM Дата: Понедельник, 18.11.2013, 16:34 | Сообщение № 11 Группа: Друзья Ранг: Старожил Сообщений: 1762 Репутация: 498 ± Замечаний: 0% ± 2003 & 2010 Альбина, и что? Мы теперь будем на каждый чих переписывать код? Вообще-то, вам выше правильно советовали сразу получить нужный вид сводной, а не напрягать уже готовые таблицы дополнительным функционалом. С другой стороны, вы в макросе разбирались? Или вам (как, между прочим, многим здесь) — «некогда, поскольку начальство напрягает и всё надо ещё вчера»? Так поверьте, многих из нас тоже напрягают — и ничего, успеваем и работать, и новые знания получать, и делиться ими. Нет, конечно, макрос-то не влом переписать — но ведь там минимум исправлений требуется. Вот только помощь наша уходит в песок… и вы рискуете с таким подходом очень быстро исчерпать запас здешних альтруистов [vba] Код Sub test()      Application.ScreenUpdating = False            i = 17      cPriz = «~»            Do          If Cells(i, 2) <> cPriz And cPriz <> «~» Then              Rows(i).Insert              Cells(i, 2) = «Итого с признаком ‘» & Cells(i — 1, 2) & «‘:»              Cells(i, 2).Resize(, 4).Interior.ColorIndex = 36              Cells(i, 3) = nSum              ‘Cells(i, 1).Resize(, 2).Merge              cPriz = «~»          Else              If cPriz = «~» Then                  nSum = 0                  If Cells(i, 2) = «X» Or Cells(i, 2) = «» Then                      cPriz = Cells(i, 2)                  End If              End If              If Cells(i, 2) = cPriz Then                  nSum = nSum + Cells(i, 3)              End If          End If          i = i + 1      Loop Until Left(Cells(i, 1), 5) = «Всего»            Application.ScreenUpdating = True        End Sub [/vba] Skype: andre.tm.007 Donate: Qiwi: 9517375010   Ответить

Альбина Дата: Понедельник, 18.11.2013, 16:53 | Сообщение № 12 Группа: Пользователи Ранг: Новичок Сообщений: 23 Репутация: 7 ± Замечаний: 0% ± Очень извиняюсь, если я вас обидела. Естественно я разбиралась с макросом. Я потому и выставляла изначально упрощенный вариант, чтобы получить направление, в котором можно разобраться с данной задачей. Я не программист, то, что i = 17, т. к. данные начинаются с 17 строки я поняла, ну и то, что номер столбца может варьироваться, а с объединенными ячейками не разобралась. Спасибо, что потратили время и помогли мне.   Ответить

В диалоговом окне Промежуточные итоги (Subtotal) :

• Раскрывающийся список При каждом изменении в (Ateach change) устанавливает, по какому столбцу группируются данные. В данном случае выберем Компьютер .
• Раскрывающийся список Операция (Use function) устанавливает операцию, выполняемую над данными. Выберем Сумма (Sum) .
• Список Добавить итоги по (Add subtotal to) устанавливает данные, которые участвуют в расчетах. В данном случае выберем Количество .
• Флажок Заменить текущие итоги (Replace current subtotals) определяет, надо ли заменить старые промежуточные итоги на вновь созданные. Сбросим этот флажок.
• Флажок Конец страницы между группами (Page break between groups) определяет, надо ли вставлять символ конца страницы после каждой группы, для которой подводятся промежуточные итоги. Сбросим этот флажок.
• Флажок Итоги под данными (Summary below data) определяет расположение промежуточных итогов под или над данными, по которым подводятся итоги. Расположим их под данными и поэтому установим флажок Итоги под данными (Summary below data) .

Нажмем кнопку ОК в диалоговом окне Промежуточные итоги (Subtotal) , что приведет к созданию промежуточных итогов на рабочем листе по выделенному диапазону данных (рисунок 3).

Рис.3. Результат выполнения команды Промежуточные итоги

На VBA тот же результат достигается применением следующих инструкций:

Рис.4. Результат добавления показателя средней реализации компьютеров по месяцам

На VBA тот же результат достигается применением следующих инструкций:

Рис.5. Вывод промежуточных итогов без детализации

На VBA тот же результат достигается применением следующих инструкций:

Здесь свойство Outline рабочего листа возвращает объект Outline (Структура) , а свойство ShowLevels объекта Outline устанавливает отображаемый уровень детализации.

Для удаления промежуточных итогов следует выделить данные с этими итогами, выполнив команду Данные | Итоги (Data | Subtotal) и нажать кнопку Убрать все (Remove All) в появившемся диалоговом окне Промежуточные итоги (Subtotal) . На VBA тот же результат достигается применением следующих инструкций:

Со следующего шага мы начнем рассматривать сценарии .

Источник

Метод Range.Subtotal (Excel)

Создает промежуточные итоги для диапазона (или текущего региона, если диапазон является одной ячейкой).

Синтаксис

expression. Промежуточный итог (GroupBy, Function, TotalList, Replace, PageBreaks, SummaryBelowData)

выражение: переменная, представляющая объект Range.

Параметры

Имя	Обязательный или необязательный	Тип данных	Описание
GroupBy	Обязательный	Long	Поле для группировки в виде одночисленного смещения. Дополнительные сведения см. в примере.
Function	Обязательный	XlConsolidationFunction	Функция промежуточных итогов.
TotalList	Обязательный	Variant	Массив из 1 смещения полей, указывающих поля, к которым добавляются промежуточные итоги. Дополнительные сведения см. в примере.
Replace	Необязательный	Variant	Значение True для замены существующих промежуточных итогов. Значение по умолчанию — True.
PageBreaks	Необязательный	Variant	Значение true для добавления разрывов страниц после каждой группы. Значение по умолчанию — False.
SummaryBelowData	Необязательный	XlSummaryRow	Размещает сводные данные относительно промежуточных итогов.

Возвращаемое значение

Пример

В этом примере создаются промежуточные итоги для выделения на листе Sheet1. Промежуточные итоги — это суммы, сгруппированные по каждому изменению в поле 1, а промежуточные итоги добавляются к полям 2 и 3.

Поддержка и обратная связь

Есть вопросы или отзывы, касающиеся Office VBA или этой статьи? Руководство по другим способам получения поддержки и отправки отзывов см. в статье Поддержка Office VBA и обратная связь.

Источник

Свойство PivotField.Subtotals (Excel)

Возвращает или задает промежуточные итоги, отображаемые с указанным полем. Допустимо только для полей без данных. Для чтения и записи, Variant.

Синтаксис

expression. Промежуточные итоги (индекс)

Выражение Переменная, представляющая объект PivotField .

Параметры

Имя	Обязательный или необязательный	Тип данных	Описание
Индекс;	Необязательный	Variant	Индекс промежуточных итогов, как показано в следующей таблице. Если этот аргумент опущен, метод Subtotals возвращает массив, содержащий логическое значение для каждой промежуточных итогов.

Замечания

Если индекс имеет значение True, в поле отображается промежуточный итог. Если индекс 1 (автоматический) имеет значение True, все остальные значения имеют значение False.

Указатель	Описание
1	Автоматически
2	Sum
3	Count
4	СРЗНАЧ
5	Max
6	Min
7	Продукт
8	Количество чисел
9	StdDev
10	StdDevp
11	Var
12	Диспр

Для источников данных OLAP индекс может возвращать только значение 1 (автоматически). Возвращаемый массив всегда содержит значение True или False для первого элемента массива, а для всех остальных элементов — значение False . Массив значений элементов, все из которых имеют значение False , указывает на отсутствие промежуточных итогов.

Пример

В этом примере задается поле, содержащее активную ячейку для отображения итоговых итогов.

Поддержка и обратная связь

Есть вопросы или отзывы, касающиеся Office VBA или этой статьи? Руководство по другим способам получения поддержки и отправки отзывов см. в статье Поддержка Office VBA и обратная связь.

Источник

Как скрыть все промежуточные итоги в сводной таблице в Excel

Что делает макрос: Создание сводной таблицы Excel включает в себя промежуточные итоги по умолчанию. Это неизбежно приводит к отчету, который пугает множеством цифр, что делает его трудным.

Вы можете вручную скрыть все промежуточные итоги сразу перейдя в ленте и выбрав Работа со Сводными Таблицами➜Дизайн➜Макет➜Промежуточные➜Не Показывать
Промежуточные Итоги. Но опять же, если вы строите автоматизированный процесс, который постоянно манипулирует сводными таблицами без ручного вмешательства, вы можете
предпочесть вариант макроса.

Как макрос работает

Если вы записываете макрос, в то время как скрываете промежуточные итоги в сводной таблице, Excel производит код, похожий на этот:

Excel передает массив с 12 ложными параметрами. Есть 12 экземпляров false, потому что есть двенадцать видов промежуточных итогов — сумма, среднее, количество, минимум и максимум и т.д. Итак, когда вы выключите промежуточные итоги во время записи макроса в Excel наборы всех возможных видов значение false.
Альтернативный способ отключить «итоги» — это первый комплект из 12 промежуточных итогов в True. Это автоматически заставляет других 11 видов в false. Мы после этого устанавливаем так же Итого в ложь, скрывая все промежуточные итоги. В этот кусок кода, мы создаем первый промежуточный итог True, а затем установить его в false. Это удаляет промежуточный итог для области.

В этом макросе мы используем этот трюк, чтобы выключить промежуточные итоги для каждого поля сводной таблицы в активной сводной таблице.

Код макроса

Как этот код работает

1. Шаг 1 объявляет две переменные объекта. Этот макрос использует РТ в качестве контейнера памяти для сводной таблицы и использует PF в качестве контейнера памяти для полей. Это позволяет перебрать все сводные поля в сводной таблице. Этот макрос разработан таким образом, что мы выводим активную сводную таблицу на основе активной ячейки. То есть, активная ячейка должна быть внутри сводной таблицы для запуска этого макроса. Когда курсор находится внутри определенной сводной таблицы, мы хотим, выполнить действие макроса на этой оси.
2. Шаг 2 устанавливает переменную СТ к имени сводной таблицы на которой найдена активная ячейка. Мы делаем это, используя свойство ActiveCell.PivotTable.Name, чтобы получить имя целевого диапазона.
   Если активная ячейка не находится внутри сводной таблицы, выдается ошибка. Именно поэтому макрос использует On Error Resume Next Statement. Это говорит Excel продолжить макро, если есть ошибка.
3. Шаг 3 проверяет в переменной РТ заполнены ли сводные таблицы объекта. Если переменная PT установлена в настоящее время, активная ячейка была не на сводной таблице, таким образом, сводной таблице не может быть присвоена переменная. Если это так, то мы говорим пользователю в окне сообщения, а затем выходим из процедуры.
4. Если макрос достигает Шаг 4, он успешно указал на сводную таблицу. Мы готовы к циклу для всех полей в сводной таблице. Оператор For Each перебирает каждое поле сводной.
   Каждый раз, когда выбрано новое поле сводной, мы применяем нашу логику Итого. После того, как все поля были оценены, макрос заканчивается.

Как использовать

Для реализации этого макроса, вы можете скопировать и вставить его в стандартный модуль:

1. Активируйте редактор Visual Basic, нажав ALT + F11.
2. Щелкните правой кнопкой мыши имя проекта / рабочей книги в окне проекта.
3. Выберите Insert➜Module.
4. Введите или вставьте код.

Источник