Этот пост содержит бесплатный макрос VBA, который преобразует любую сводную таблицу в отчет, содержащий формулы SUMIFS, COUNTIFS или AVERAGEIFS. Если вы хотите очень быстро создать длинную формулу SUMIFS, это ваш билет.

- Сводная таблица или Формулы SUMIFS?
- Сводные таблицы
- Формулы SUMIFS
- Преобразовать сводную таблицу в формулы SUMIFS
- Что конкретно делает макрос?
- Написание макроса
- Код VBA
- Как реализовать этот код
- Добавьте модуль кода в вашу личную книгу макросов
- Работает с таблицами и структурированными ссылками
- Работает с фильтром страницы нескольких критериев
- Статьи по теме
- VBA Сводная таблица Ссылки
Сводная таблица или Формулы SUMIFS?
Что лучше — сводная таблица или формулы SUMIFS? Это старый вопрос при создании пользовательского отчета или панели мониторинга, и теперь вы можете иметь и то, и другое!

Сводные таблицы
Преимущество сводных таблиц заключается в том, что вы можете быстро создать красиво отформатированный отчет, который обобщает ваши данные. Они очень быстрые и мощные, и экономят много времени.
Недостатком является то, что расположение сводной таблицы на рабочем листе может быть ограничивающим. Вам может потребоваться больше гибкости в структуре обобщенных данных при создании пользовательских диаграмм, панелей мониторинга, интерактивных отчетов и т.д. Сводные таблицы также требуют, чтобы пользователь вручную обновлял их при обновлении исходных данных.
Формулы SUMIFS
Это может привести нас к использованию формул SUMIFS вместо сводной таблицы.
Преимущество формул SUMIFS заключается в том, что вы можете рассчитать сумму на основе нескольких критериев в любом месте таблицы. Они также рассчитываются автоматически при обновлении исходных данных.
Недостатком является то, что SUMIFS — это длинные формулы, которые требуют много времени для ввода. Они также более подвержены ошибкам и требуют большего обслуживания при изменении диапазона исходных данных (добавлены новые строки).
Преобразовать сводную таблицу в формулы SUMIFS
Недавно я работал над проектом, в котором я писал множество формул SUMIFS для перетаскивания чисел на панель инструментов. Формулы SUMIFS отлично подходят для этого, потому что вы можете сделать панель мониторинга интерактивной, используя выпадающие списки (проверка ячеек), и результаты обновляются автоматически.
Моя проблема заключалась в том, что я тратил много времени на написание различных формул SUMIFS. Я хотел быстро создать эти длинные формулы.

Поэтому я написал этот макрос, который берет сводную таблицу и преобразует ее в формулы SUMIFS, COUNTIFS или AVERAGEIFS. Это означает, что вы можете в основном писать формулы, используя удобство сводной таблицы. Когда в вашей сводной таблице есть все поля, необходимые для формулы SUMIFS, вы просто нажимаете кнопку для создания формул.
Что конкретно делает макрос?
Код VBA приведен ниже, и вы также можете скачать рабочую книгу, содержащую этот код. Я также объясню несколько способов использования этого кода ниже.
Вот общее описание того, что делает макрос:
- Создает новый лист в книге.
- Копирует оболочку сводной таблицы на новый лист (строки, столбцы, области фильтрации страниц и форматирование).
- Перебирает каждую ячейку в области значений и создает формулу SUMIFS, COUNTIFS или AVERAGEIFS на новом листе. Формулы имитируют вычисление поля значений в сводной таблице.
Вы можете использовать новый лист в качестве основы для своего настраиваемого отчета или скопировать формулы на другой лист в рабочей книге. Есть много способов, как вы могли бы использовать это.
Написание макроса
Самым сложным в создании этого кода является обработка всех потенциальных макетов сводной таблицы. Сводная таблица может иметь компактную, контурную или табличную форму, а итоги и промежуточные итоги отображаются в разных местах.
Для формул SUMIFS наиболее удобный макет будет табличным с повторяющимися элементами. Но я не хотел ограничивать код только этим, поэтому я попытался приспособить все возможности макета.
Я не могу сказать, что код еще совершенен, но он обрабатывает все макеты, которые я тестировал до сих пор. Я уверен, что вы найдете ошибки, и я буду обновлять код по мере возникновения проблем.
Код VBA
Dim pvt As PivotTable Dim rSource As Range Dim wsSource As Worksheet Dim bTable As Boolean Sub Convert_Pivot_to_Formulas() 'все ячейки в области значений для формул SUMIFS, COUNTIFS или AVERAGEIFS 'Подробности: ниже приведен список функций, требований и ограничений макроса. 'Характеристики '- Работает с полями страницы с несколькими элементами в фильтре одного поля страницы. '- Создает критерии поля страницы по столбцам и создает формулы массива. ' Требования '- Поля в сводной таблице, содержащие даты, должны быть в том же формате, что и исходные данные. '- Исходные данные должны быть в той же книге. Это может быть расширено для ссылки на исходные данные в других книгах. 'Ограничения '- Не работает с сгруппированными полями даты. Диапазоны критериев НЕ существуют в исходных данных. 'Для решения этой проблемы создайте поля группы дат в виде столбцов в исходных данных. '--------------------------------------------------------------------------------------- Dim pi As PivotItem Dim pc As PivotCell Dim pf As PivotField Dim wsNew As Worksheet Dim wsPivot As Worksheet Dim c As Range Dim lFunction As Long Dim sSumRange As String Dim sCritRange As String Dim sCriteria As String Dim sFormula As String Dim sFormulaPage As String Dim sSearchField As String Dim sDataSheet As String Dim lDataRows As Long Dim sPageRange As String Dim lCol As Long Dim bArray As Boolean Dim sTableName As String Dim sFormulaArgs As String Dim sFormulaCnt As String Dim lLblRow As Long Dim lLblCol As Long ' Установить переменные сводной таблицы On Error Resume Next Set pvt = ActiveCell.PivotTable Set wsPivot = ActiveSheet On Error GoTo 0 If pvt Is Nothing Then MsgBox "Please select a Pivot Table first.", vbOKOnly, "Convert Pivot to Formula Error" Exit Sub End If ' Проверьте, находятся ли исходные данные в той же книге. If Get_Pivot_Source Then On Error GoTo Err_Handle '------------------------------------------------------- '1. Создайте новый лист с оболочкой сводной таблицы - фильтр, строки, области столбцов '------------------------------------------------------- Set wsNew = Worksheets.Add(after:=ActiveSheet) sDataSheet = wsSource.Name lDataRows = rSource.Rows.Count If bTable Then sTableName = pvt.SourceData ' Скопируйте значения сводной таблицы на новый лист wsPivot.Select wsPivot.Range(pvt.TableRange1.Address).Copy With wsNew.Range(pvt.TableRange1.Address) .PasteSpecial Paste:=xlPasteValues .PasteSpecial Paste:=xlPasteFormats .PasteSpecial Paste:=xlPasteColumnWidths End With If pvt.PageFields.Count > 0 Then wsPivot.Range(pvt.PageRange.Address).Copy With wsNew.Range(pvt.PageRange.Address) .PasteSpecial Paste:=xlPasteValues .PasteSpecial Paste:=xlPasteFormats .PasteSpecial Paste:=xlPasteColumnWidths End With End If '------------------------------------------------------- '2. Добавьте фильтры полей страницы по столбцам в новом листе. '------------------------------------------------------- If pvt.PageFields.Count > 0 Then For Each pf In pvt.PageFields sPageRange = pf.LabelRange.Offset(, 1).Resize(1,1).Address sFilter = pf.LabelRange.Offset(, 1).Resize(1, 1).Value lCol = 0 'offset 1 col to the right Select Case sFilter Case "(All)" 'Пропуск Case "(Multiple Items)" ' Зацикливайте элементы поворота и добавляйте выбранные элементы в диапазон страниц по столбцам. For Each pi In pf.PivotItems If pi.Visible Then wsNew.Range(sPageRange).Offset(, lCol).Resize(1,1).Value = pi.Name lCol = lCol + 1 End If Next pi Case Else ' Один предмет выбран lCol = 1 wsPivot.Range(sPageRange).Offset(, lCol).Resize(1, 1).Value = wsNew.Range(sPageRange).Offset(, lCol).Resize(1, 1).Value End Select ' Создать строку для формулы If lCol > 0 Then ' фильтры существуют If bTable Then sCritRange = sTableName & "[" & pf.Name & "]" Else sSearchField = pf.Name sCritRange = "'" & sDataSheet & "'!" & rSource.Resize(1).Find(What:=sSearchField, LookAt:=xlWhole).Offset(1).Resize(lDataRows - 1, 1).Address End If sCriteria = wsNew.Range(sPageRange).Resize(1, lCol).Address sFormulaPage = sFormulaPage & "," & sCritRange sFormulaPage = sFormulaPage & "," & sCriteria End If ' Формула IFS должна быть массивом, если в аргументе критерия есть несколько критериев (диапазон) If lCol > 1 Then bArray = True Next pf End If '------------------------------------------------------- '3. Прокрутите каждую ячейку в области значений, чтобы построить формулу. '------------------------------------------------------- For Each c In pvt.DataBodyRange.Cells Set pc = c.PivotCell sFormula = "" sFormulaArgs = "" '------------------------------------------------------- '4. Создайте ссылку SUM RANGE для формулы '------------------------------------------------------- ' Проверьте, является ли функция суммой, количеством или средним If pc.PivotField.Function = xlSum Or pc.PivotField.Function = xlCount Or pc.PivotField.Function = xlAverage Then ' Подсчитайте критерии, если 0, то это всего и не требуется IFS sCriteria = "" ' Добавить элементы столбца в массив фильтра If pc.PivotCellType = xlPivotCellValue Then sDataField = pc.PivotField.SourceName lFunction = pc.PivotField.Function ' Добавить диапазон сумм lFunction = pc.PivotField.Function If bTable Then sSumRange = sTableName & "[" & pc.PivotField.SourceName & "]" Else sSearchField = pc.PivotField.SourceName sSumRange = "'" & sDataSheet & "'!" & rSource.Resize(1).Find(What:=sSearchField, LookAt:=xlWhole).Offset(1).Resize(lDataRows - 1, 1).Address End If '------------------------------------------------------- '5. Переберите элементы ROW в сводной ячейке и добавьте ссылки на строки в формулу. '------------------------------------------------------- If pc.RowItems.Count Then For Each pi In pc.RowItems If bTable Then sCritRange = sTableName & "[" & pi.Parent.Name & "]" Else sSearchField = pi.Parent.Name sCritRange = "'" & sDataSheet & "'!" & rSource.Resize(1).Find(What:=sSearchField, LookAt:=xlWhole).Offset(1).Resize(lDataRows - 1, 1).Address End If ' Найти адрес диапазона меток сводных ячеек для адреса критерия ' Начните с текущей строки и выполните цикл по диапазону меток до ' Имя элемента сводной таблицы найдено. Требуется из-за разнообразия макетов сводных таблиц. lLblCol = pi.LabelRange.Column For lLblRow = c.Row To pi.Parent.LabelRange.Row + 1 Step -1 If Cells(lLblRow, lLblCol).Value = pi.Name Then sCriteria = Cells(lLblRow, pi.LabelRange.Column).Address Exit For End If Next lLblRow If sCriteria <> "" Then sFormulaArgs = sFormulaArgs & "," & sCritRange sFormulaArgs = sFormulaArgs & "," & sCriteria End If sCriteria = "" Next pi End If '------------------------------------------------------- '6. Просмотрите элементы COLUMN в сводной ячейке и добавьте ссылки на ряды в формулу. '------------------------------------------------------- If pc.ColumnItems.Count Then For Each pi In pc.ColumnItems If bTable Then sCritRange = sTableName & "[" & pi.Parent.Name & "]" Else sSearchField = pi.Parent.Name sCritRange = "'" & sDataSheet & "'!" & rSource.Resize(1).Find(What:=sSearchField, LookAt:=xlWhole).Offset(1).Resize(lDataRows - 1, 1).Address End If ' Найти адрес диапазона меток сводных ячеек для адреса критерия ' Начните с текущего столбца и возвращайтесь влево через диапазон меток до ' Имя элемента сводной таблицы найдено. Требуется из-за разнообразия макетов сводных таблиц. lLblRow = pi.LabelRange.Row For lLblCol = c.Column To pi.LabelRange.Column Step -1 If Cells(lLblRow, lLblCol).Value = pi.Name Then sCriteria = Cells(pi.LabelRange.Row, lLblCol).Address Exit For End If Next lLblCol If sCriteria <> "" Then sFormulaArgs = sFormulaArgs & "," & sCritRange sFormulaArgs = sFormulaArgs & "," & sCriteria End If sCriteria = "" Next pi End If '------------------------------------------------------- '7. Формула построения на основе типа функции сводной ячейки '------------------------------------------------------- Select Case pc.PivotField.Function Case xlSum If sFormulaArgs = "" And sFormulaPage = "" Then ' Не нужен IFS, когда нет критериев (всего строк / столбцов) sFormula = "=SUM(" & sSumRange & ")" Else If bArray Then sFormula = "=SUM(SUMIFS(" & sSumRange & sFormulaPage & sFormulaArgs & "))" Else sFormula = "=SUMIFS(" & sSumRange & sFormulaPage & sFormulaArgs & ")" End If End If Case xlCount If sFormulaArgs = "" And sFormulaPage = "" Then ' Не нужен IFS, когда нет критериев (всего строк / столбцов) sFormula = "=COUNT(" & sSumRange & ")" Else sFormulaCnt = sFormulaPage & sFormulaArgs 'Не нужно диапазон суммы для показателей sFormulaCnt = Right(sFormulaCnt, Len(sFormulaCnt) - 1) ' обрезать перед запятой If bArray Then sFormula = "=SUM(COUNTIFS(" & sFormulaCnt & "))" Else sFormula = "=COUNTIFS(" & sFormulaCnt & ")" End If End If Case xlAverage If sFormulaArgs = "" And sFormulaPage = "" Then ' Не нужен IFS, когда нет критериев (всего строк / столбцов) sFormula = "=AVERAGE(" & sSumRange & ")" Else sFormula = "=AVERAGEIFS(" & sSumRange & sFormulaPage & sFormulaArgs & ")" ' AVERAGEIFS не работает с формулой массива, возвращает ошибки End If End Select '------------------------------------------------------- '8. Добавить формулу на новый лист '------------------------------------------------------- If bArray Then If Len(sFormula) < 255 Then wsNew.Range(c.Address).FormulaArray = sFormula Else '.FormulaArray выдает ошибку, если строка формулы> 255 символов ' Добавить обработку ошибок здесь End If Else wsNew.Range(c.Address).Formula = sFormula End If End If End If Next c End If wsNew.Select Exit Sub Err_Handle: MsgBox Err.Description & vbNewLine & "Current Cell: " & c.Address, _ vbCritical, "Convert Pivot to Formulas Error" End Sub Function Get_Pivot_Source() As Boolean Dim bReturn As Boolean ' Определите, является ли источник ссылкой на ячейку, именованным диапазоном или таблицей Excel. ' Установите исходные переменные диапазона ' Попробуйте проверить свойство PivotCache.SourceType. 'http://msdn.microsoft.com/en-us/library/office/ff194557.aspx On Error GoTo Err_Handler ' Установить переменные для выбранной сводной таблицы bReturn = False Set rSource = Nothing Set wsSource = Nothing bTable = False If pvt.PivotCache.SourceType = xlDatabase Then If InStr(pvt.SourceData, "[") = 0 Then ' проверить, содержат ли исходные данные имя книги - обойти диапазон внешнего источника - Temp TO DO If InStr(pvt.SourceData, ":") > 0 Then ' если диапазон источника данных является диапазоном ссылки на ячейку Set rSource = Application.Evaluate(Application.ConvertFormula(pvt.SourceData, xlR1C1, xlA1)) Else ' если таблица или именованный диапазон используются в качестве диапазона источника данных Set rSource = Range(pvt.SourceData) On Error GoTo SkipTable ' проверить, является ли имя источника данных таблицей Set rSource = Range(pvt.SourceData & "[#All]") bTable = True SkipTable: On Error GoTo 0 End If Set wsSource = rSource.Parent bReturn = True End If End If Get_Pivot_Source = bReturn Exit Function Err_Handler: MsgBox "Error in Get_Source_Range procedure." Get_Pivot_Source = False End Function
Как реализовать этот код
Не волнуйтесь, если весь этот код заставляет вашу голову кружиться. Скоро выйдет новая надстройка с именем PivotPal, которая будет содержать эту функцию.

Это означает, что вы сможете запускать этот макрос в любое время одним нажатием кнопки.
Добавьте модуль кода в вашу личную книгу макросов
Вы также можете добавить код в свою личную книгу макросов, а затем назначить ей кнопку ленты. Вот статья о том, как создать личную макрокоманду.
На снимке экрана ниже я добавил макрос в свою личную книгу макросов, а затем назначил ей кнопку на вкладке «Формулы» на ленте.

Вы также можете скопировать модуль кода в любую рабочую книгу и изменить или настроить его по мере необходимости. Есть много возможностей с этим кодом.
Работает с таблицами и структурированными ссылками
Код также работает с таблицами Excel и структурированными ссылками. Если ваш диапазон исходных данных представляет собой таблицу, то код создаст гораздо более приятные на вид формулы. Эти формулы более динамичны, когда строки добавляются к исходным данным.

Это означает, что формулы будут автоматически включать любые новые строки, которые добавляются в таблицу (исходные данные). Использование таблиц значительно сократит объем обслуживания, которое потребуется вашим формулам.
Работает с фильтром страницы нескольких критериев
Код будет работать, если в вашей сводной таблице есть фильтр страниц с несколькими выбранными критериями. Код обнаружит, когда в фильтре выбрано несколько критериев, и создаст формулы массива для SUMIFS. Также будут перечислены критерии в столбцах справа от полей страницы.

Как вы можете видеть на рисунке выше, код работает с довольно сложными компоновками. Я не могу гарантировать, что он будет работать в каждом сценарии, но он определенно должен охватывать не только основы.
Статьи по теме
Mynda Treacy недавно написала отличную статью о формулах Interactive Excel и объясняет, как вы можете использовать формулы SUMIFS для своих отчетов и панелей мониторинга. Не забудьте проверить мои бесплатные призы, когда вы записываетесь на один из курсов Mynda.
VBA Сводная таблица Ссылки
Ниже приведены несколько отличных статей и ресурсов для обучения написанию VBA для сводных таблиц. Они действительно помогли мне написать этот код.
- Информационный список полей сводной таблицы Excel VBA — Дебра Далглиш
- Ссылки на диапазоны сводных таблиц в VBA — Джон Пельтье
- Получение исходного диапазона сводной таблицы с помощью VBA — Дик Куслейка