Фильтр исходных данных в сводной таблице

У любого уважающего себя тренера всегда есть запас "вау-фишек" - простых, но эффектных приемов, эдаких killing-features для быстрого очарования сложной аудитории. В сводных таблицах одной из таких фишек, безусловно, является двойной щелчок левой кнопкой мыши по любому числу в области значений:

filter-pivot1.png

Если это сделать, то вас вынесет на новый лист, куда Excel выгрузит детализацию по данной ячейке - всю "подноготную", объясняющую как получилось данное значение, из чего оно сложилось:

filter-pivot2.png

Официально, эта процедура называется drill-down, неофициально ее обычно называют "провалиться".

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

Но порой возникает другое желание: а можно увидеть не копию исходных данных, а сами данные? То есть отфильтровать те самые строки в исходной таблице, которые участвуют в расчете данной ячейки? Их, например, можно было бы затем изменить, подкорректировав тем самым результат в сводной таблице.

Стандартными средствами такое невозможно, но для макросов пределы возможного в Excel существенно шире :)

Откройте редактор Visual Basic:

  • В Excel 2003 и старше для этого нужно выбрать в меню Сервис - Макрос - Редактор Visual Basic (Tools - Macro - Visual Basic Editor)
  • В новых версиях Excel 2007-2013 перейти на вкладку Разработчик (Developer) и нажать кнопку Visual Basic. Если такой вкладки у вас не видно, то включите ее в настройках Файл - Параметры - Настройка ленты (File - Options - Customize Ribbon)

В окне редактора вставьте новый модуль через меню Insert - Module и скопируйте туда текст вот этих двух макросов:

Sub FilterPivot()
    Dim pt As PivotTable
    
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False

    Set pt = ActiveCell.PivotTable
    Set rSource = Application.Evaluate(Application.ConvertFormula(pt.SourceData, xlR1C1, xlA1))
    rSource.EntireRow.Hidden = False
    nCols = rSource.Columns.Count
    Selection.ShowDetail = True
    Set rDrill = ActiveSheet.UsedRange
    Set shDrill = ActiveSheet
    DrillLastRow = shDrill.Range("A1").End(xlDown).Row
    For i = nCols To 1 Step -1
        formulatxt = formulatxt & "RC[-" & i & "]&"
    Next i
    formulatxt = Left(formulatxt, Len(formulatxt) - 1)
    shDrill.Cells(2, nCols + 1).Resize(DrillLastRow - 1, 1).FormulaR1C1 = "=" & formulatxt

    For j = 2 To rSource.Rows.Count
        contxt = ""
        For i = 1 To nCols
            contxt = contxt & rSource.Cells(j, i).Value
        Next i
        If WorksheetFunction.CountIf(shDrill.Cells(2, nCols + 1).Resize(DrillLastRow - 1, 1), contxt) = 0 Then
            rSource.Cells(j, 1).EntireRow.Hidden = True
        End If
    Next j

    shDrill.Delete
    rSource.Parent.Activate

    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Sub ShowAllData()
    ActiveSheet.Rows.Hidden = False
End Sub

Теперь, если выделить одну любую ячейку с данными в сводной таблице и запустить наш первый макрос FilterPivot с помощью сочетания клавиш Alt+F8 или через меню Сервис - Макрос - Макросы (Tools - Macro - Macros), то мы перейдем на лист с исходными данными для сводной, где автоматически будут применены фильтры, отбирающие только те строки, которые участвовали в расчете текущей ячейки:

filter-pivot3.png

Теперь их можно, например, изменить, чтобы добиться в отчете сводной таблицы нужного результата. Только не забудьте обновить сводную после внесения изменений: правой кнопкой мыши - Обновить (Refresh).

Второй макрос ShowAllData нужен, чтобы вернуть прежний вид исходной таблицы - он делает все строки на текущем листе видимыми. Для пущего удобства можно повесить эти два макроса на удобные вам сочетания клавиш, используя кнопку Параметры (Options) в окне Макросы, которое отображается по Alt+F8.

Ссылки по теме

 


08.03.2013 19:56:44
Мощно 8) будем пользоваться:)
27.03.2013 14:00:19
У меня макрос "FilterPivot" вываливается с сообщением
"Run-time error 1004:
Невозможно получить свойство CountIf класса WorksheetFunction"

В режиме отладки желтой заливкой выделяется строка 27 кода
If WorksheetFunction.CountIf(shDrill.Cells(2, nCols + 1).Resize(DrillLastRow - 1, 1), contxt) = 0 Then

Таблица с исходными данными у меня большая (более 400 тыс.строк и 76 столбцов)

А макрос "ShowAllData" кричит "недостаточно ресурсов" (16 Гб оперативки, проц - i7 два ядра четыре потока)
27.05.2020 06:47:13
не решили эту проблему в макросе ?
07.04.2013 14:22:38
А у меня, независимо от выделенной ячейки сводной, в источнике оставляет только заголовки и вторую строку (
09.08.2013 11:37:41
Dima S, чтобы первая строка тоже скрывалась измените в коде строку:
For j = 2 To rSource.Rows.Count
на
For j = 1 To rSource.Rows.Count
15.11.2013 09:59:18
На форуме решили проблему Dima S на счет пустых ячеек
http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=52660
09.12.2013 13:00:15
Здравствуйте, Николай! У меня после выполнения  макроса "FilterPivot" также выводится сообщение
"Run-time error 1004:
Невозможно получить свойство CountIf класса WorksheetFunction". В чем причина?
11.12.2013 19:37:37
Не могу сказать не видя вашего файла. Пришлите на почту - посмотрю, помогу, ага?
26.02.2014 18:58:30
Ваш на больших таблицах не всегда работает, переделал под себя:
По двойному клику на сводной, сразу фильтрует исходную таблицу.
Работает с длинными текстовыми данными.
Обновляется автоматом при возврате на лист со сводной.
Скорость можно еще увеличить при работе с громадными таблицами:
1. не использовать Union
2. Сравнивать количество найденных строк и если все найдены, то все оставшиеся скрывать.
3. Так как количество отобранных строк, в большинстве случаев меньше скрываемых (Можно проверить программно), то использовать сначала скрытие всех строк, а затем отображение найденных.(При использовании Union)
---------------------
Скрытый текст


Sub FilterPivot()
    Dim pt As PivotTable
     
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
 On Error GoTo ext
    Set pt = ActiveCell.PivotTable
    Set rSource = Application.Evaluate(Application.ConvertFormula(pt.SourceData, xlR1C1, xlA1))
    rSource.EntireRow.Hidden = False
    ncols = rSource.Columns.Count
    Selection.ShowDetail = True
    Set rdrill = ActiveSheet.UsedRange
    Set shDrill = ActiveSheet
    DrillLastRow = shDrill.Range("A1".End(xlDown).Row
    a = rdrill.Value
    b = rSource.Value
     For j = 1 To rSource.Rows.Count
        Nbl = True: bl = False
        For i = 1 To ncols
          For ii = 2 To UBound(a)
            If b(j, i) = a(ii, i) Then bl = True: Exit For
          Next ii
          If Not bl Then Nbl = True: bl = False: Exit For Else bl = False: Nbl = False
         Next i
                  If Nbl Then
                        If Not IsEmpty(r) Then
                          Set r = Union(r, rSource.Rows(j))
                        Else
                          Set r = rSource.Rows(j)
                        End If
                       
                   End If
     Next j
     If Not IsEmpty(r) Then r.EntireRow.Hidden = True
     

    shDrill.Delete
    rSource.Parent.Activate
ext:
 If Err.Number <> 0 Then MsgBox "Выделите диапазон редактирования"
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub
 
Sub ShowAllData()
    ActiveSheet.Rows.Hidden = False
End Sub 
и в модуль листа со сводной

Private Sub Worksheet_Activate()
For i = 1 To ActiveSheet.PivotTables.Count
ActiveSheet.PivotTables(i).PivotCache.Refresh
Next
End Sub   

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
FilterPivot
Cancel = True
End Sub
 
B.Key, я бы переменные все объявил и добавил после этой строки:
Set pt = ActiveCell.PivotTable
вот такой блок:
    If Not pt.EnableDrilldown Then 
'        MsgBox "Разрешите отображение деталей: Параметры сводной таблицы-Данные-Разрешить отображение деталей", vbCritical 
'        Exit Sub 
'или 
        pt.EnableDrilldown = True 
    End If
Иначе есть большой шанс вместо редактирования источника удалить напрочь лист самой сводной, ибо не провалится в детали по двойному щелчку, а останется на сводной...

Николай, в твоем коде это тоже не помешало бы добавить ;)
26.02.2014 20:03:00
Николай, заранее прошу прощения за возможно некомпетентный вопрос: можно ли каким-то образом сделать так, чтобы макрос отображался не только в текущей книге, а также во всех других (новых) при их открытии? (т.е.чтобы он стал как бы "предустановленным" для всех создаваемых книг)
К сожалению, в интернете не удалось найти ясного описания того, как это можно сделать, поэтому и задаю данный вопрос.
22.05.2014 12:30:49
Доброго времени суток.

Коллеги, как сделать чтобы фильтр исходных данных шел по ячейкам первого столбца сводной таблицы, и еще вопрос: можно как-то выделить ячейки в сводной таблице по которым можно производить фильтр исходной, например как в гиперссылках.

Заранее спасибо.
18.12.2014 01:12:27
Всем у кого после запуска макроса  "FilterPivot" также выводится сообщение
"Run-time error 1004:" не забываем что запускать его нужно из вкладки "Лист1"
там где соответственно и есть сводная, а не данные. ;)
04.06.2015 10:57:19
Доброго времени суток, столкнулся с трудностью в работе с макросом. Макрос работает, ошибок не выдает, но бывает, что в сводной к примеру число "5", а когда через макрос в нее провалишься, он там только 2 к примеру отобразит. Хотя на соседней цифре провалишься с помощью макроса - покажет корректно. Спасибо.
Наверх