Note: The other languages of the website are Google-translated. Back to English

Как отфильтровать сводную таблицу на основе определенного значения ячейки в Excel?

Обычно мы фильтруем данные в сводной таблице, выбирая элементы в раскрывающемся списке, как показано на снимке экрана ниже. На самом деле вы можете фильтровать сводную таблицу на основе значения в конкретной ячейке. Метод VBA в этой статье поможет вам решить проблему.

Фильтрация сводной таблицы на основе определенного значения ячейки с кодом VBA


Фильтрация сводной таблицы на основе определенного значения ячейки с кодом VBA

Следующий код VBA может помочь вам отфильтровать сводную таблицу на основе определенного значения ячейки в Excel. Пожалуйста, сделайте следующее.

1. Пожалуйста, введите значение, по которому вы будете фильтровать сводную таблицу в ячейку заранее (здесь я выбираю ячейку H6).

2. Откройте рабочий лист, содержащий сводную таблицу, которую вы отфильтруете по значению ячейки. Затем щелкните правой кнопкой мыши вкладку листа и выберите Просмотреть код из контекстного меню. Смотрите скриншот:

3. В дебюте Microsoft Visual Basic для приложений окно, скопируйте ниже код VBA в окно кода.

Код VBA: фильтрация сводной таблицы на основе значения ячейки

Private Sub Worksheet_Change(ByVal Target As Range)
'Update by Extendoffice 20180702
    Dim xPTable As PivotTable
    Dim xPFile As PivotField
    Dim xStr As String
    On Error Resume Next
    If Intersect(Target, Range("H6:H7")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xPTable = Worksheets("Sheet1").PivotTables("PivotTable2")
    Set xPFile = xPTable.PivotFields("Category")
    xStr = Target.Text
    xPFile.ClearAllFilters
    xPFile.CurrentPage = xStr
    Application.ScreenUpdating = True
End Sub

Заметки: В коде

1) "Sheet1»- это имя рабочего листа.
2) "Сводная таблица2»- это название сводной таблицы.
3) Поле фильтрации в сводной таблице называется "Категория".
4) Значение, которое вы хотите отфильтровать в сводной таблице, помещается в ячейку H6.
Вы можете изменить указанные выше значения переменных по своему усмотрению.

4. нажмите другой + Q ключи, чтобы закрыть Microsoft Visual Basic для приложений окно.

Затем сводная таблица фильтрует на основе значения в ячейке H6, как показано ниже:

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

Внимание: Значения, которые вы вводите в ячейку H6, должны точно соответствовать значениям в раскрывающемся списке «Категория» сводной таблицы.


Статьи по теме:


Лучшие инструменты для работы в офисе

Kutools for Excel решает большинство ваших проблем и увеличивает вашу производительность на 80%

  • Снова использовать: Быстро вставить сложные формулы, диаграммы и все, что вы использовали раньше; Зашифровать ячейки с паролем; Создать список рассылки и отправлять электронные письма ...
  • Бар Супер Формулы (легко редактировать несколько строк текста и формул); Макет для чтения (легко читать и редактировать большое количество ячеек); Вставить в отфильтрованный диапазон...
  • Объединить ячейки / строки / столбцы без потери данных; Разделить содержимое ячеек; Объединить повторяющиеся строки / столбцы... Предотвращение дублирования ячеек; Сравнить диапазоны...
  • Выберите Дубликат или Уникальный Ряды; Выбрать пустые строки (все ячейки пустые); Супер находка и нечеткая находка во многих рабочих тетрадях; Случайный выбор ...
  • Точная копия Несколько ячеек без изменения ссылки на формулу; Автоматическое создание ссылок на несколько листов; Вставить пули, Флажки и многое другое ...
  • Извлечь текст, Добавить текст, Удалить по позиции, Удалить пробел; Создание и печать промежуточных итогов по страницам; Преобразование содержимого ячеек в комментарии...
  • Суперфильтр (сохранять и применять схемы фильтров к другим листам); Расширенная сортировка по месяцам / неделям / дням, периодичности и др .; Специальный фильтр жирным, курсивом ...
  • Комбинируйте книги и рабочие листы; Объединить таблицы на основе ключевых столбцов; Разделить данные на несколько листов; Пакетное преобразование xls, xlsx и PDF...
  • Более 300 мощных функций. Поддерживает Office/Excel 2007-2021 и 365. Поддерживает все языки. Простое развертывание на вашем предприятии или в организации. Полнофункциональная 30-дневная бесплатная пробная версия. 60-дневная гарантия возврата денег.
вкладка kte 201905

Вкладка Office: интерфейс с вкладками в Office и упрощение работы

  • Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Издатель, доступ, Visio и проект.
  • Открывайте и создавайте несколько документов на новых вкладках одного окна, а не в новых окнах.
  • Повышает вашу продуктивность на 50% и сокращает количество щелчков мышью на сотни каждый день!
офисный дно
Сортировать комментарии по
Комментарии (23)
Оценок пока нет. Оцените первым!
Этот комментарий был сведен к минимуму модератором на сайте
Используя этот код (конечно, обновленный для моих переменных), при изменении поля фильтр мгновенно меняется на правильный, а затем почти сразу очищается. Попытка выяснить, почему он это делает (интересно, имеет ли это какое-то отношение к ClearAllFilters в конце подраздела?)
Этот комментарий был сведен к минимуму модератором на сайте
Как бы вы сделали это с фильтром отчета, который имеет иерархию?
Этот комментарий был сведен к минимуму модератором на сайте
Привет! Спасибо за ваш макрос.

Я пытался использовать его для нескольких сводных таблиц на одной странице, но это не сработало. Я написал это так:

Private Sub Worksheet_Change (ByVal Target As Range)
Dim xPTable1 как сводная таблица
Dim xPFile1 как PivotField
Dim xStr1 как строка
On Error Resume Next
Если Intersect(Target, Range("D7")) ничего не значит, тогда выйдите из Sub
Приложение.ScreenUpdating = False
Установите xPTable1 = Рабочие листы ("BUSCADOR"). Сводные таблицы ("PV_ETAPA1")
Установите xPFile1 = xPTable1.PivotFields("ETAPA1")
xStr1 = Цель.Текст
xPFile1.ClearAllFilters
xPFile1.CurrentPage = xStr1
Application.ScreenUpdating = True

Dim xPTable2 как сводная таблица
Dim xPFile2 как PivotField
Dim xStr2 как строка
On Error Resume Next
Если Intersect(Target, Range("G7")) ничего не значит, тогда выйдите из Sub
Приложение.ScreenUpdating = False
Установите xPTable2 = Рабочие листы ("BUSCADOR"). Сводные таблицы ("PV_ETAPA2")
Установите xPFile2 = xPTable2.PivotFields("ETAPA2")
xStr2 = Цель.Текст
xPFile2.ClearAllFilters
xPFile2.CurrentPage = xStr2
Application.ScreenUpdating = True

End Sub

Может быть, вы можете помочь мне!

Заранее спасибо!
Этот комментарий был сведен к минимуму модератором на сайте
Hi


спасибо за макрос


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


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

Je ne comprends pas comment ajouter le nom du second TCD dans la macro pour que cela fonctionne sur les deux.
Pourriez-vous m'aider?

спасибо
Этот комментарий был сведен к минимуму модератором на сайте
Привет, почему-то этот макрос после входа на страницу Visual Basic вообще не отображается. Я не могу включить/запустить этот макрос, я проверил все настройки центра управления безопасностью, но ничего не происходит, пожалуйста, помогите мне
Этот комментарий был сведен к минимуму модератором на сайте
Привет, я не могу заставить это работать. Ячейка, на которую я хочу сослаться, вытягивается из формулы - может быть поэтому фильтр не может найти ее, поскольку он смотрит на формулу, а не на значение, которое возвращает формула? Заранее спасибо, Хизер МакДонах.
Этот комментарий был сведен к минимуму модератором на сайте
Привет, Хизер, ты нашла решение? У меня точно такая же проблема.
Этот комментарий был сведен к минимуму модератором на сайте
Мне удалось изменить/отфильтровать 3 разных поворота, которые находятся на одной вкладке. Я также добавил строку в свой набор данных «Данные не найдены», иначе фильтр оставил значение «ВСЕ», чего я не хотел. Вышеупомянутое очень помогло мне заработать славу у руководства, поэтому я хотел поделиться. Обратите внимание, что (Все) чувствительно к регистру, мне потребовалось немного времени, чтобы понять это.
Private Sub Worksheet_Change (ByVal Target As Range)
'контрольная работа
Dim xPTable как сводная таблица
Dim xPFile как PivotField
Dim xStr как строка

Dim x2PTable как сводная таблица
Dim x2PFile как PivotField
Dim x2Str как строка

Dim x3PTable как сводная таблица
Dim x3PFile как PivotField
Dim x3Str как строка

On Error Resume Next
Если Intersect(Target, Range("a2:e2")) ничего не значит, то выйдите из Sub

Приложение.ScreenUpdating = False

'стол-1
Установить xPTable = Рабочие листы ("Графические"). Сводные таблицы ("Сводная таблица1")
Установить xPFile = xPTable.PivotFields("Отдел MR - Отдел")
xStr = Цель.Текст
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Если xPFile.CurrentPage = "(Все)", тогда xPFile.CurrentPage = "Данные не найдены"

'стол-2
Установить x2PTable = Рабочие листы ("Графические"). Сводные таблицы ("Сводная таблица2")
Установить x2PFile = x2PTable.PivotFields("Отдел MR - Отдел")
x2Str = Цель.Текст
x2PFile.ClearAllFilters
x2PFile.CurrentPage = x2Str
Если x2PFile.CurrentPage = "(Все)", тогда x2PFile.CurrentPage = "Данные не найдены"

'стол-3
Установить x3PTable = Рабочие листы ("Графические"). Сводные таблицы ("Сводная таблица3")
Установить x3PFile = x3PTable.PivotFields("Отдел MR - Отдел")
x3Str = Цель.Текст
x3PFile.ClearAllFilters
x3PFile.CurrentPage = x3Str
Если x3PFile.CurrentPage = "(Все)", тогда x3PFile.CurrentPage = "Данные не найдены"

Application.ScreenUpdating = True

End Sub
Этот комментарий был сведен к минимуму модератором на сайте
Возможно ли это с таблицами Google? Если да, то как?
Этот комментарий был сведен к минимуму модератором на сайте
Для Google Таблиц не потребуется сводная таблица. вы можете напрямую выполнять через функцию фильтра
Этот комментарий был сведен к минимуму модератором на сайте
Я хотел бы использовать несколько кодов изменения рабочего листа на одном листе. Как это сделать? Мой код выглядит следующим образом:
Private Sub Worksheet_Change (ByVal Target As Range)
'Фильтр сводной таблицы на основе значения ячейки
Dim xPTable как сводная таблица
Dim xPFile как PivotField
Dim xStr как строка
On Error Resume Next
Если Intersect(Target, Range("D20:D21")) ничего не значит, тогда выйдите из Sub
Приложение.ScreenUpdating = False
Установите xPTable = Рабочие листы («Лист1»). Сводные таблицы («Сводная таблица2»)
Установите xPFile = xPTable.PivotFields("Обозначение")
xStr = Цель.Текст
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Change2 (Цель ByVal как диапазон)
'Фильтр сводной таблицы на основе значения ячейки 2
Dim xPTable как сводная таблица
Dim xPFile как PivotField
Dim xStr как строка
On Error Resume Next
Если Intersect(Target, Range("H20:H21")) ничего не значит, тогда выйдите из Sub
Приложение.ScreenUpdating = False
Установите xPTable = Рабочие листы («Лист1»). Сводные таблицы («Сводная таблица2»)
Установите xPFile = xPTable.PivotFields("Предложение")
xStr = Цель.Текст
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub
Этот комментарий был сведен к минимуму модератором на сайте
Olá, gostaria де сабля себе quisesse filtrar mais де ума категории como poderia ser?
Этот комментарий был сведен к минимуму модератором на сайте
Что делать, если я хочу связать ячейку выбора с другой вкладкой? Это мой код до сих пор
Private Sub Worksheet_Change (ByVal Target As Range)
Dim xPTable1 как сводная таблица
Dim xPFile1 как PivotField
Dim xStr1 как строка
On Error Resume Next
Если Intersect(Target, Range("B1")) ничего не значит, тогда выйдите из Sub
Приложение.ScreenUpdating = False
Установите xPTable1 = Worksheets("SM_SKU PIVOTS").PivotTables("PivotTable1")
Установите xPFile1 = xPTable1.PivotFields("География")
xStr1 = Цель.Текст
xPFile1.ClearAllFilters
xPFile1.CurrentPage = xStr1
Application.ScreenUpdating = True

Dim xPTable2 как сводная таблица
Dim xPFile2 как PivotField
Dim xStr2 как строка
On Error Resume Next
Если Intersect(Target, Range("B1")) ничего не значит, тогда выйдите из Sub
Приложение.ScreenUpdating = False
Установите xPTable2 = Worksheets("SM_SKU PIVOTS").PivotTables("PivotTable4")
Установите xPFile2 = xPTable2.PivotFields("География")
xStr2 = Цель.Текст
xPFile2.ClearAllFilters
xPFile2.CurrentPage = xStr2
Application.ScreenUpdating = True

Dim xPTable3 как сводная таблица
Dim xPFile3 как PivotField
Dim xStr3 как строка
On Error Resume Next
Если Intersect(Target, Range("B1")) ничего не значит, тогда выйдите из Sub
Приложение.ScreenUpdating = False
Установите xPTable3 = Worksheets("SM_SKU PIVOTS").PivotTables("PivotTable8")
Установите xPFile3 = xPTable3.PivotFields("География")
xStr3 = Цель.Текст
xPFile3.ClearAllFilters
xPFile3.CurrentPage = xStr3
Application.ScreenUpdating = True

End Sub
Этот комментарий был сведен к минимуму модератором на сайте
Привет!

Я новичок в VBA и хотел бы иметь код для выбора сводного фильтра на основе диапазона ячеек.
Как я могу изменить «CurrentPage» на значение диапазона?
Спасибо!!
-------------------------------------------------- -----------------------------------------
Подпрограмма PrintTour()

ActiveSheet.PivotTables("PivotTable1").PivotFields( _
«[Береич 1].[Тур].[Тур]»). _
Очистить все фильтры
ActiveSheet.PivotTables("PivotTable1").PivotFields( _
«[Береич 1].[Тур].[Тур]»). _
CurrentPage = "[Bereich 1].[Tour lt. Anlieferungstag].&[4001-01]"
End Sub
Этот комментарий был сведен к минимуму модератором на сайте
Большое спасибо за этот код! Я заработал после настройки в соответствии с моими полями, но после форматирования некоторых изменений на моем листе теперь это не работает! Я переместил его из A1 в B1, изменил форматирование некоторых ячеек, чтобы выделить его, и т. д. Ничего особенного, но теперь он не обновляется, когда я изменяю текст в B1. У кого-нибудь есть идеи?

Private Sub Worksheet_Change (ByVal Target As Range)
'контрольная работа
Dim xPTable как сводная таблица
Dim xPFile как PivotField
Dim xStr как строка

Dim x2PTable как сводная таблица
Dim x2PFile как PivotField
Dim x2Str как строка

Dim x3PTable как сводная таблица
Dim x3PFile как PivotField
Dim x3Str как строка

On Error Resume Next
Если Intersect(Target, Range("b1")) ничего не значит, тогда выйдите из Sub

Приложение.ScreenUpdating = False

'стол-1
Установите xPTable = Worksheets("Line Report").PivotTables("PivotTable7")
Установить xPFile = xPTable.PivotFields("Источник утопии")
xStr = Цель.Текст
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr

'стол-2
Установить x2PTable = Рабочие листы («Линейный отчет»). Сводные таблицы («Сводная таблица2»)
Установить x2PFile = x2PTable.PivotFields("Источник утопии")
x2Str = Цель.Текст
x2PFile.ClearAllFilters
x2PFile.CurrentPage = x2Str

'стол-3
Установить x3PTable = Рабочие листы («Линейный отчет»). Сводные таблицы («Сводная таблица3»)
Установить x3PFile = x3PTable.PivotFields("Источник утопии")
x3Str = Цель.Текст
x3PFile.ClearAllFilters
x3PFile.CurrentPage = x3Str

Application.ScreenUpdating = True

End Sub
Этот комментарий был сведен к минимуму модератором на сайте
Привет Лэнс,
Я проверил ваш код, и он отлично работает в моем случае. Изменение формата ячейки не влияет на работу кода.
Этот комментарий был сведен к минимуму модератором на сайте
Как это работает с Power Pivot при использовании нескольких таблиц? Я записал макрос, изменяющий значение в фильтре. Внесено несколько изменений, чтобы приведенный выше код работал. Но выдает ошибку несоответствия типа. Неважно что я делаю.
Этот комментарий был сведен к минимуму модератором на сайте
Привет ДК,
Этот метод не работает для Power Pivot. Извините за беспокойство.
Этот комментарий был сведен к минимуму модератором на сайте
Привет,
Большое спасибо за эти объяснения.

J'aimerai utiliser un filtre (1 cellule) en F4 par example qui filtrerait deux TCD qui sont sur la meme feuille.

Cela fonctionne très bien avec un TCD mais dès que j'essaye de comber le second, ça ne marche pas.
Не могли бы вы помочь мне ?

Merci Ьеаисоир
Эмброуз
Этот комментарий был сведен к минимуму модератором на сайте
Привет,

Merci beaucoup pour cette explication qui Marche parfaitement.
En revanche, j'aimerais pouvoir utiliser ce code pour pouvoir filtrer deux tableaux croisés dynamiques en meme temps qui sont sur la même feuille. La seule petite différence entre les deux, c'est qu'ils n'utilisent pas les memes sources. En revanche, ле filtre sur lequel себе базы ces TDC ЭСТ ле Même.

Pourriez-vous m'aider à faire évoluer ce code afin que cela fonctionne?

Голосовой код, используемый в том или ином виде, с TCD:

Private Sub Worksheet_Change (ByVal Target As Range)
'Обновить Extendoffice 20180702
Dim xPTable как сводная таблица
Dim xPFile как PivotField
Dim xStr как строка
On Error Resume Next
Если Intersect(Target, Range("G4")) ничего не значит, тогда выйдите из Sub
Приложение.ScreenUpdating = False
Установите xPTable = Worksheets("Cadrage").PivotTables("Tableau croisé dynamique7")
Установите xPFile = xPTable.PivotFields("N°PROJET")
xStr = Цель.Текст
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub

Merci Ьеаисоир
Этот комментарий был сведен к минимуму модератором на сайте
Привет Амбруаз,

Извините, этот код сложно изменить в соответствии с вашими потребностями. Если вы хотите отфильтровать несколько сводных таблиц с помощью одного фильтра, методы, описанные в этой статье ниже, могут оказать вам услугу:
Как подключить один слайсер к нескольким сводным таблицам в Excel?
Здесь еще нет комментариев
Оставляйте свои комментарии
Публикация как гость
×
Оценить этот пост:
0   Характеристики
Предлагаемые места

Подписывайтесь на Нас

Copyright © 2009 - www.extendoffice.ком. | Все права защищены. Питаться от ExtendOffice, | Карта сайта
Microsoft и логотип Office являются товарными знаками или зарегистрированными товарными знаками Microsoft Corporation в США и / или других странах.
Защищено Sectigo SSL