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 для Excel вирішує більшість ваших проблем і збільшує продуктивність на 80%

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

Вкладка Office забезпечує інтерфейс з вкладками для Office і значно спрощує вашу роботу

  • Увімкніть редагування та читання на вкладках у Word, Excel, PowerPoint, Publisher, Access, Visio та Project.
  • Відкривайте та створюйте кілька документів на нових вкладках того самого вікна, а не в нових вікнах.
  • Збільшує вашу продуктивність на 50% та зменшує сотні клацань миші для вас щодня!
дно офісної таблиці
Коментарі (23)
Поки немає оцінок. Оцініть першим!
Цей коментар був мінімізований модератором на сайті
Використовуючи цей код (звісно, ​​оновлений для моїх змінних), при зміні поля фільтр на мить змінюється на правильний, а потім майже відразу очищається. Намагаючись з’ясувати, чому він це робить (цікаво, чи має це якесь відношення до ClearAllFilters в кінці підпорядкування?)
Цей коментар був мінімізований модератором на сайті
Як би ви це зробили з фільтром звіту, який має ієрархію?
Цей коментар був мінімізований модератором на сайті
Гей! Дякую за ваш макрос.

Я намагався використовувати його для кількох зведених таблиць на одній сторінці, але це не працює. Я написав це так:

Приватний допоміжний робочий лист_Change(ByVal Target As Range)
Dim xPTable1 як зведена таблиця
Dim xPFile1 як PivotField
Dim xStr1 як рядок
On Error Resume Next
Якщо Intersect(Target, Range("D7")) Нічого, вийдіть із Sub
Application.ScreenUpdating = Невірний
Встановити xPTable1 = Worksheets("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
Application.ScreenUpdating = Невірний
Встановити xPTable2 = Worksheets("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?

Merci
Цей коментар був мінімізований модератором на сайті
Привіт чомусь цей макрос після входу на базову візуальну сторінку взагалі не відображається. Я не можу ввімкнути/запустити цей макрос, я перевірив усі налаштування центру довіри, але нічого не відбувається, будь ласка, допоможіть мені
Цей коментар був мінімізований модератором на сайті
Привіт, я не можу змусити це працювати. Клітинку, на яку я хочу посилатися, витягується з формули – чи через це фільтр не може знайти її, оскільки переглядає формулу, а не значення, яке повертає формула? Наперед дякую, Хезер МакДона
Цей коментар був мінімізований модератором на сайті
Привіт Хізер, чи знайшли ви рішення? У мене така ж проблема.
Цей коментар був мінімізований модератором на сайті
Мені вдалося змінити/відфільтрувати 3 різні опорні точки, які знаходяться на одній вкладці. Я також додав рядок у свій набір даних «Даних не знайдено», інакше він залишив фільтр «ВСЕ», чого я не хотів. Наведене вище було чудовою допомогою, щоб заслужити похвалу від керівництва, тому я хотів поділитися. Зауважте, що (All) чутливий до регістру, мені знадобилося трохи зрозуміти це.
Приватний допоміжний робочий лист_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")) Нічого, то вийдіть з підпорядкування

Application.ScreenUpdating = Невірний

'tbl-1
Встановити xPTable = Worksheets("Graphical").PivotTables("PivotTable1")
Встановіть xPFile = xPTable.PivotFields("Відділ МР - Відділ")
xStr = Ціль.Текст
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Якщо xPFile.CurrentPage = "(Всі)", Тоді xPFile.CurrentPage = "Даних не знайдено"

'tbl-2
Встановити x2PTable = Worksheets("Graphical").PivotTables("PivotTable2")
Встановіть x2PFile = x2PTable.PivotFields("Відділ МР - Відділ")
x2Str = Ціль.Текст
x2PFile.ClearAllFilters
x2PFile.CurrentPage = x2Str
Якщо x2PFile.CurrentPage = "(Всі)", Тоді x2PFile.CurrentPage = "Даних не знайдено"

'tbl-3
Встановити x3PTable = Worksheets("Graphical").PivotTables("PivotTable3")
Встановіть x3PFile = x3PTable.PivotFields("Відділ МР - Відділ")
x3Str = Ціль.Текст
x3PFile.ClearAllFilters
x3PFile.CurrentPage = x3Str
Якщо x3PFile.CurrentPage = "(Всі)", Тоді x3PFile.CurrentPage = "Даних не знайдено"

Application.ScreenUpdating = True

End Sub
Цей коментар був мінімізований модератором на сайті
Чи можливо це за допомогою таблиць Google? Якщо так, то як?
Цей коментар був мінімізований модератором на сайті
Google Таблиці не потребують зведеної таблиці. Ви можете виконувати безпосередньо через функцію фільтра
Цей коментар був мінімізований модератором на сайті
Я хотів би використовувати кілька кодів зміни робочого аркуша в одному аркуші. Як це зробити? Мій код такий:
Приватний допоміжний робочий лист_Change(ByVal Target As Range)
«Фільтр зведеної таблиці на основі значення комірки
Dim xPTable як зведена таблиця
Dim xPFile як PivotField
Dim xStr як рядок
On Error Resume Next
Якщо Intersect(Target, Range("D20:D21")) Нічого, вийдіть з підпорядкування
Application.ScreenUpdating = Невірний
Встановити xPTable = Worksheets("Sheet1").PivotTables("PivotTable2")
Встановіть xPFile = xPTable.PivotFields("Позначення")
xStr = Ціль.Текст
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub

Приватний додатковий аркуш_Change2(ByVal Target As Range)
"Фільтр зведеної таблиці на основі значення комірки 2
Dim xPTable як зведена таблиця
Dim xPFile як PivotField
Dim xStr як рядок
On Error Resume Next
Якщо Intersect(Target, Range("H20:H21")) Нічого, вийдіть з підпорядкування
Application.ScreenUpdating = Невірний
Встановити xPTable = Worksheets("Sheet1").PivotTables("PivotTable2")
Встановіть xPFile = xPTable.PivotFields("Пропозиція")
xStr = Ціль.Текст
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub
Цей коментар був мінімізований модератором на сайті
Olá, gostaria de sabre se quisesse filterar mais de uma categoria como poderia ser?
Цей коментар був мінімізований модератором на сайті
Що робити, якщо я хочу зв’язати клітинку виділення з іншою вкладкою? Поки що це мій код
Приватний допоміжний робочий лист_Change(ByVal Target As Range)
Dim xPTable1 як зведена таблиця
Dim xPFile1 як PivotField
Dim xStr1 як рядок
On Error Resume Next
Якщо Intersect(Target, Range("B1")) Нічого, вийдіть із Sub
Application.ScreenUpdating = Невірний
Встановити 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
Application.ScreenUpdating = Невірний
Встановити 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
Application.ScreenUpdating = Невірний
Встановити xPTable3 = Worksheets("SM_SKU PIVOTS").PivotTables("PivotTable8")
Встановіть xPFile3 = xPTable3.PivotFields("Географія")
xStr3 = Ціль.Текст
xPFile3.ClearAllFilters
xPFile3.CurrentPage = xStr3
Application.ScreenUpdating = True

End Sub
Цей коментар був мінімізований модератором на сайті
Привіт!

Я новачок у VBA, і я хотів би мати код для вибору зведеного фільтра на основі діапазону комірок.
Як я можу змінити "CurrentPage" на значення діапазону?
Дякую!!
-------------------------------------------------- -----------------------------------------
Піддрукований тур()

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

Приватний допоміжний робочий лист_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

Application.ScreenUpdating = Невірний

'tbl-1
Установіть xPTable = Worksheets("Line Report").PivotTables("PivotTable7")
Установіть xPFile = xPTable.PivotFields("Джерело Utopia")
xStr = Ціль.Текст
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr

'tbl-2
Установіть x2PTable = Worksheets("Line Report").PivotTables("PivotTable2")
Установіть x2PFile = x2PTable.PivotFields("Utopia Source")
x2Str = Ціль.Текст
x2PFile.ClearAllFilters
x2PFile.CurrentPage = x2Str

'tbl-3
Установіть x3PTable = Worksheets("Line Report").PivotTables("PivotTable3")
Установіть x3PFile = x3PTable.PivotFields("Utopia Source")
x3Str = Ціль.Текст
x3PFile.ClearAllFilters
x3PFile.CurrentPage = x3Str

Application.ScreenUpdating = True

End Sub
Цей коментар був мінімізований модератором на сайті
Привіт Ленс,
Я перевірив ваш код, і він добре працює в моєму випадку. Зміна формату комірки не впливає на роботу коду.
Цей коментар був мінімізований модератором на сайті
Як це працює з Power Pivot під час використання кількох таблиць? Я записав макрос, який змінює значення у фільтрі. Внесено кілька змін, щоб наведений вище код працював. Але це видає помилку невідповідності типу. Що б я не робив.
Цей коментар був мінімізований модератором на сайті
Привіт DK!
Цей метод не працює для Power Pivot. Вибачте за незручності.
Цей коментар був мінімізований модератором на сайті
Привіт,
Дуже дякую за ці пояснення.

J'aimerai utiliser un filtre (1 cellule) en F4 par exemple qui filtrerait deux TCD qui sont sur la même feuille.

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

Дуже дякую
Емброуз
Цей коментар був мінімізований модератором на сайті
Привіт,

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 même temps qui sont sur la même feuille. La seule petite différence entre les deux, c'est qu'ils n'utilisent pas les mêmes sources. En revanche, le filtre sur lequel se base ces TDC est le même.

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

Голосовий код, який використовується для маршу з TCD:

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

Дуже дякую
Цей коментар був мінімізований модератором на сайті
Привіт Амбруаз,

Вибачте, але важко змінити цей код відповідно до ваших потреб. Якщо ви хочете відфільтрувати кілька зведених таблиць за допомогою одного фільтра, методи, описані в цій статті, можуть стати вам у нагоді.
Як підключити один слайсер до кількох зведених таблиць у Excel?
There are no comments posted here yet
Залишайте свої коментарі
Публікація як гість
×
Оцініть цю публікацію:
0   Персонажі
Рекомендовані місця

Слідуй за нами

Copyright © 2009 - WWW.extendoffice.com. | Всі права захищені. На основі ExtendOffice. | Карта сайту
Microsoft та логотип Office є товарними знаками або зареєстрованими товарними знаками Microsoft Corporation у США та / або інших країнах.
Захищений Sectigo SSL