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

Як зв’язати фільтр зведеної таблиці з певною коміркою в Excel?

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

Пов’язати фільтр зведеної таблиці з певною коміркою з кодом VBA


Пов’язати фільтр зведеної таблиці з певною коміркою з кодом VBA

Зведена таблиця, до якої ви пов’яжете свою функцію фільтра, зі значенням комірки повинна містити поле фільтра (ім’я поля фільтра відіграє важливу роль у наступному коді VBA).

Візьмемо нижченаведену зведену таблицю як приклад. Викликається поле фільтра в зведеній таблиці Категорія, і воно включає два значення “Витрати"І"Sales". Після зв’язування фільтра зведеної таблиці з коміркою, значення комірки, які ви застосовуватимете до зведеної таблиці фільтра, мають бути “Витрати” та “Продажі”.

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")) 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, тоді відповідні дані у зведеній таблиці відфільтровуються на основі існуючого значення. Дивіться знімок екрана:

При зміні значення комірки відфільтровані дані у зведеній таблиці будуть автоматично змінені. Дивіться знімок екрана:


Легко виділіть цілі рядки на основі значення комірки в стовпці сертифіката:

повне г, повне г,, показали, від, номер, XNUMX Виберіть певні клітини корисність Kutools для Excel може допомогти вам швидко вибрати цілі рядки на основі значення комірки в стовпці сертифіката в Excel, як показано на знімку екрана нижче. Вибравши всі рядки на основі значення комірки, ви можете вручну перемістити або скопіювати їх у нове розташування, як це потрібно в Excel.
Завантажте та спробуйте зараз! (30-денна безкоштовна траса)


Статті по темі:


Найкращі інструменти для підвищення продуктивності офісу

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% та зменшує сотні клацань миші для вас щодня!
дно офісної таблиці
Коментарі (36)
Поки немає оцінок. Оцініть першим!
Цей коментар був мінімізований модератором на сайті
як це зробити на кількох полі, оскільки в коді є лише одна ціль
Цей коментар був мінімізований модератором на сайті
Привіт, Френк
Сорі не може допомогти вам у цьому.
Цей коментар був мінімізований модератором на сайті
Що робити, якщо клітинка, яка пов’язана зі зведеною таблицею, в даному випадку H6, знаходиться на іншому аркуші? Як це змінює код?
Цей коментар був мінімізований модератором на сайті
що, якщо у мене є більше 1 зведеної таблиці та посилання на 1 клітинку. Як мені змінити код?
Цей коментар був мінімізований модератором на сайті
Привіт, Джері,
Вибачте, не можу вам з цим допомогти. Ласкаво просимо опублікувати будь-які запитання на нашому форумі: https://www.extendoffice.com/forum.html щоб отримати додаткову підтримку Excel від професіоналів Excel або інших шанувальників Excel.
Цей коментар був мінімізований модератором на сайті
знайдіть їх і змініть у Array(), Intersect(), Worksheets(), PivotFields()

Зведена таблиця1
Зведена таблиця2
Зведена таблиця3
Зведена таблиця4
H1
Ім'я аркуша
Ім'я поля




Private Sub Worksheet_Change(ByVal Target As Range)
'Update by Extendoffice 20180702
    Dim xPTable As PivotTable
    Dim xPFile As PivotField
    Dim xPTabled As PivotTable
    Dim xPFiled As PivotField
    Dim xStr As String
    On Error Resume Next
    '리스트 만들기
    Dim listArray() As Variant
    listArray = Array("PivotTable1", "PivotTable2", "PivotTable3", "PivotTable4")
    If Intersect(Target, Range("H1")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    For i = 0 To UBound(listArray)
        Set xPTable = Worksheets("SheetName").PivotTables(listArray(i))
        Set xPFile = xPTable.PivotFields("FieldName")
        'MsgBox (listArray(i))
        xStr = Target.Text
        xPFile.ClearAllFilters
        xPFile.CurrentPage = xStr
    Next
        Application.ScreenUpdating = True
End Sub
Цей коментар був мінімізований модератором на сайті
Боа-тард...! Ótima publicação, como faço para utilizar o filtro em duas ou mais tabelas dinâmicas...? Agradeço desde já.

Добрий день...! Чудова публікація, як використовувати фільтр у двох або більше зведених таблицях ...? Заздалегідь спасибі.
Цей коментар був мінімізований модератором на сайті
Привіт Гілмар Алвес!
Вибачте, не можу вам з цим допомогти. Ласкаво просимо опублікувати будь-які запитання на нашому форумі: https://www.extendoffice.com/forum.html щоб отримати додаткову підтримку Excel від професіоналів Excel або інших шанувальників Excel.
Цей коментар був мінімізований модератором на сайті
Хтось зрозумів питання про зв’язування кількох зведених таблиць?
Цей коментар був мінімізований модератором на сайті
Змінити значення в Array(), Worksheets() і Intersect()



**Знайди це та зміни**
Ім'я аркуша
E1
Зведена таблиця1
Зведена таблиця2
Зведена таблиця3




Приватний допоміжний робочий лист_Change(ByVal Target As Range)
'Оновлення до Extendoffice 20180702
Dim xPTable як зведена таблиця
Dim xPFile як PivotField

Dim xPTabled As PivotTable
Dim xPFiled As PivotField

Dim xStr як рядок



On Error Resume Next

'리스트 만들기
Dim listArray() як варіант
listArray = Array("Зведена таблиця1", "Зведена таблиця2", "Зведена таблиця3")



Якщо Intersect(Target, Range("E1")) не має значення, вийдіть із Sub
Application.ScreenUpdating = Невірний

Для i = 0 до UBound(listArray)

Установіть xPTable = Worksheets("SheetName").PivotTables(listArray(i))
Установіть xPFile = xPTable.PivotFields("Company_ID")

xStr = Ціль.Текст
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr



Далі

Application.ScreenUpdating = True



End Sub
Цей коментар був мінімізований модератором на сайті
Чао, sto provando a fare lo stesso esempio per far in modo che il filtro della pivot si setti sul valore della cella,
non riesco a farla funzionare.

Quale passaggio manca nella descrizione sopra?
Цей коментар був мінімізований модератором на сайті
привіт,
Ви отримували повідомлення про помилку? Мені потрібно дізнатися більше про вашу проблему, наприклад, вашу версію Excel. І якщо ви не проти, спробуйте створити свої дані в новій книзі та спробуйте ще раз або зробіть знімок екрана своїх даних і завантажте його сюди.
Цей коментар був мінімізований модератором на сайті
привіт,

Намагався змусити це працювати для фільтра стовпців, але, здається, не працює. Чи потрібен мені інший код для цього?

Дякую
Цей коментар був мінімізований модератором на сайті
Привіт Джастін,
Ви отримували повідомлення про помилку? Мені потрібно дізнатися більше про вашу проблему.
Перш ніж застосовувати код, не забудьте змінити "назва аркуша""назва зведеної таблиці""назва фільтра зведеної таблиці"та осередок ви хочете відфільтрувати зведену таблицю на основі (див. знімок).
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/4.png
Цей коментар був мінімізований модератором на сайті
Привіт Кристал,

Спасибі за вашу допомогу. Проблема в тому, що функція чомусь нічого не робить. Деякі уточнення:

Зведена назва: Order_Comp_B2C
Назва аркуша: Розрахунковий лист
Назва фільтра: Номер тижня (я змінив цю назву на назву "Тиждень відправлення" у файлі даних)
Клітинку для зміни: O26 і O27 (це має входити в діапазон)

У цьому зведеному я намагаюся змінити фільтр для стовпців, у мене немає нічого в області фільтра в меню Поля зведеної таблиці.

мій код:

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

Спасибі,

Джастін
Цей коментар був мінімізований модератором на сайті
Привіт, Джастін Тю!
Я змінив Назва опори, назва аркуша, назва фільтра і клітинку змінити до умов, які ви згадували вище, і спробував код VBA, який ви надали, він добре працює в моєму випадку. Перегляньте наведений нижче GIF або додану книгу.
Ви не проти створити нову книгу та спробувати код ще раз?
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/6.gif
Цей коментар був мінімізований модератором на сайті
Привіт Кристал,

У доданому скріншоті зведено, червоне поле — це фільтр, який я хотів би змінити на основі значення комірки.

Бажано, щоб я хотів використовувати діапазон клітинок, що вказують кілька тижневих номерів.

Спасибі,

Джастін
Цей коментар був мінімізований модератором на сайті
Привіт Джастін,
Вибачте, я не бачив знімок екрана, який ви додали на сторінці. Можливо на сторінці якась помилка.
Якщо вам все ще потрібно вирішити проблему, напишіть мені на zxm@addin99.com. Вибачте за незручності.
Цей коментар був мінімізований модератором на сайті
Привіт Джастін Теу,
Спробуйте наступний код VBA. Сподіваюся, я можу допомогти.

Private Sub Worksheet_Change(ByVal Target As Range)
    'Update by Extendoffice 20220706
    Dim I As Integer
    Dim xFilterStr1, xFilterStr2 As String
    On Error Resume Next
    If Intersect(Target, Range("O26:O27")) Is Nothing Then Exit Sub
    'Application.ScreenUpdating = False
    
    xFilterStr1 = Range("O26").Value
    xFilterStr2 = Range("O27").Value
    ActiveSheet.PivotTables("Order_Comp_B2C").PivotFields("Week Number"). _
        ClearAllFilters
    If xFilterStr1 = "" And xFilterStr2 = "" Then Exit Sub
    ActiveSheet.PivotTables("Order_Comp_B2C").PivotFields("Week Number"). _
        EnableMultiplePageItems = True
    xCount = ActiveSheet.PivotTables("Order_Comp_B2C").PivotFields("Week Number").PivotItems.Count

    For I = 1 To xCount
        If I <> xFilterStr1 And I <> xFilterStr2 Then
            ActiveSheet.PivotTables("Order_Comp_B2C").PivotFields("Week Number").PivotItems(I).Visible = False
        Else
            ActiveSheet.PivotTables("Order_Comp_B2C").PivotFields("Week Number").PivotItems(I).Visible = True
        End If
    Next

    'Application.ScreenUpdating = True
End Sub
Цей коментар був мінімізований модератором на сайті
Я використовував його для звичайного Excel, і він працював. Але я не міг використовувати його для робочих аркушів olap. може мені треба трохи змінити?
Цей коментар був мінімізований модератором на сайті
Привіт maziaritib4 TIB,
Метод доступний лише для Microsoft Excel. Вибачте за незручності.
Цей коментар був мінімізований модератором на сайті
Привіт Джастін,

Це спрацювало ідеально, однак мені цікаво, чи можна застосувати це правило до кількох зведених таблиць на одному аркуші?

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

Так, це можливо, код, який я використав для цього (4 опорні точки та 2 посилання на клітинки):

Приватний допоміжний робочий лист_Change(ByVal Target As Range)
Dim I As Integer
Dim xFilterStr1, xFilterStr2, yFilterstr1, yfilterstr2 як рядок
On Error Resume Next
Якщо Intersect(Target, Range("O26:P27")) не є нічим, тоді вийдіть із Sub

xFilterStr1 = Діапазон ("O26"). Значення
xFilterStr2 = Діапазон ("O27"). Значення
yFilterstr1 = Діапазон ("p26"). Значення
yfilterstr2 = Діапазон ("p27"). Значення
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Номер тижня"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Номер тижня"). _
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Номер тижня"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Номер тижня"). _
Очистити всі фільтри

If xFilterStr1 = "" And xFilterStr2 = "" And yFilterstr1 = "" And yfilterstr2 = "" Then Exit Sub
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Номер тижня"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Номер тижня"). _
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Номер тижня"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Номер тижня"). _
EnableMultiplePageItems = True

xCount = ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Номер тижня").PivotItems.Count
xCount = ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Номер тижня").PivotItems.Count
yCount = ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Номер тижня").PivotItems.Count
yCount = ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Номер тижня").PivotItems.Count

Для I = 1 До xCount
Якщо I <> xFilterStr1 And I <> xFilterStr2 Тоді
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Номер тижня").PivotItems(I).Visible = False
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Номер тижня").PivotItems(I).Visible = False
Ще
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Номер тижня").PivotItems(I).Visible = True
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Номер тижня").PivotItems(I).Visible = True
End If
Далі

Для I = 1 До yCount
Якщо I <> yFilterstr1 And I <> yfilterstr2 Тоді
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Номер тижня").PivotItems(I).Visible = False
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Номер тижня").PivotItems(I).Visible = False
Ще
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Номер тижня").PivotItems(I).Visible = True
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Номер тижня").PivotItems(I).Visible = True
End If
Далі

End Sub
Цей коментар був мінімізований модератором на сайті
Змінити значення в Array(), Worksheets() і Intersect()



**Знайди це та зміни**
Ім'я аркуша
E1
Зведена таблиця1
Зведена таблиця2
Зведена таблиця3




Приватний допоміжний робочий лист_Change(ByVal Target As Range)
'Оновлення до Extendoffice 20180702
Dim xPTable як зведена таблиця
Dim xPFile як PivotField

Dim xPTabled As PivotTable
Dim xPFiled As PivotField

Dim xStr як рядок



On Error Resume Next

'리스트 만들기
Dim listArray() як варіант
listArray = Array("Зведена таблиця1", "Зведена таблиця2", "Зведена таблиця3")



Якщо Intersect(Target, Range("E1")) не має значення, вийдіть із Sub
Application.ScreenUpdating = Невірний

Для i = 0 до UBound(listArray)

Установіть xPTable = Worksheets("SheetName").PivotTables(listArray(i))
Установіть xPFile = xPTable.PivotFields("Company_ID")

xStr = Ціль.Текст
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr



Далі

Application.ScreenUpdating = True



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

Код працює добре для мене. Однак я не можу змусити зведену таблицю автоматично оновлювати цільовий фільтр. Метою в моєму випадку є формула [ДАТА(D18,S14,C18)]. Код працює лише тоді, коли я двічі клацаю цільову клітинку та натискаю Enter.

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

Цей код працює ідеально. Однак я не можу отримати код для автоматичного оновлення зведеної таблиці. Цільовим значенням для мене є формула (=ДАТА(D18,..,..)), яка змінюється залежно від того, що вибрано в D18. Щоб оновити зведену таблицю, мені потрібно двічі клацнути цільову клітинку та натиснути Enter. Чи є спосіб обійти це?

Дякую
Цей коментар був мінімізований модератором на сайті
Привіт ST,
Припустімо, що ваше цільове значення знаходиться в H6 і воно змінюється залежно від значення в D18. Щоб відфільтрувати зведену таблицю на основі цього цільового значення. Наведений нижче код VBA може допомогти. Будь ласка, спробуйте.
Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 2022/07/22
Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String
Dim xBoolean As Boolean
Dim xItsRG As Range
Dim xDDs As Range
Dim xDs As Range
On Error Resume Next

xBoolean = False
Set xRg = Range("h6")

Set xItsRG = Intersect(Target, xRg)
Set xDDs = Intersect(Target.DirectDependents, xRg)
Set xDs = Intersect(Target.Dependents, xRg)
If Not (xItsRG Is Nothing) Then
    xBoolean = True
ElseIf Not (xDDs Is Nothing) Then
    xBoolean = True
ElseIf Not (xDs Is Nothing) Then
    xBoolean = True
End If


If Not xBoolean Then Exit Sub

Application.ScreenUpdating = False
Set xPTable = Worksheets("Sheet1").PivotTables("Pivot Table 1")
Set xPFile = xPTable.PivotFields("Category")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True

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

Я додав рядок до коду: Dim xRg As Range

Код не скидає автоматично дати, коли мета змінюється. У мене є файл Excel, який копіює те, що я намагаюся зробити, але я не можу додавати вкладення на цьому веб-сайті. D3 (ціль = ДАТА(A15,B15,C15)) містить рівняння, пов’язане з A15, B15 і C15. Коли змінюється будь-яке значення на A15, B15 і C15, зведена таблиця скидається на відсутність фільтра. Чи могли б ви допомогти мені з цим?
Цей коментар був мінімізований модератором на сайті
Привіт ST,
Я не дуже розумію, що ви маєте на увазі. У вашому випадку значення цільової клітинки D3 використовується для фільтрації зведеної таблиці. Формула в цільовій клітинці D3 посилається на значення клітинок A15, B15 і C15, які змінюватимуться відповідно до значень у контрольних клітинках. Коли змінюється будь-яке значення на A15, B15 і C15, зведена таблиця буде автоматично відфільтрована, якщо значення в цільовій клітинці відповідає умовам фільтра зведеної таблиці. Якщо значення в цільовій комірці не відповідає критеріям фільтрації зведеної таблиці, зведену таблицю буде автоматично скинуто до відсутності фільтрації.
Цей коментар був мінімізований модератором на сайті
Я не впевнений, чи є спосіб поділитися з вами файлом Excel. Якщо моє цільове значення, яким є дата, змінюється відповідно до змін в інших клітинках. Мені потрібно двічі клацнути цільову клітинку та натиснути Enter (як після введення формули в клітинку), щоб оновити зведену таблицю
Цей коментар був мінімізований модератором на сайті
Привіт Сагар Т.
Код оновлено. Будь ласка, спробуйте. Дякуємо за ваш відгук.
Не забудьте змінити назви аркуша, зведеної таблиці та фільтра в коді. Або ви можете завантажити наступний завантажений зошит для тестування.

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20220805
Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String
Dim xBoolean As Boolean
Dim xItsRG As Range
Dim xDDs As Range
Dim xDs As Range
On Error Resume Next

xBoolean = False
Set xRg = Range("D3")

Set xItsRG = Intersect(Target, xRg)
Set xDDs = Intersect(Target.DirectDependents, xRg)
Set xDs = Intersect(Target.Dependents, xRg)
If Not (xItsRG Is Nothing) Then
    xBoolean = True
ElseIf Not (xDDs Is Nothing) Then
    xBoolean = True
ElseIf Not (xDs Is Nothing) Then
    xBoolean = True
End If


If Not xBoolean Then Exit Sub
xStr = Format(xRg.Text, "m/d/yyyy")
Application.ScreenUpdating = False
Set xPTable = Worksheets("Sheet2").PivotTables("PivotTable1")
Set xPFile = xPTable.PivotFields("Date")
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True

End Sub
Цей коментар був мінімізований модератором на сайті
знайдіть їх і змініть у Array(), Intersect(), Worksheets(), PivotFields()

Зведена таблиця1
Зведена таблиця2
Зведена таблиця3
Зведена таблиця4
H1
Ім'я аркуша
Ім'я поля




Private Sub Worksheet_Change(ByVal Target As Range)
'Update by Extendoffice 20180702
    Dim xPTable As PivotTable
    Dim xPFile As PivotField
    Dim xPTabled As PivotTable
    Dim xPFiled As PivotField
    Dim xStr As String
    On Error Resume Next
    '리스트 만들기
    Dim listArray() As Variant
    listArray = Array("PivotTable1", "PivotTable2", "PivotTable3", "PivotTable4")
    If Intersect(Target, Range("H1")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    For i = 0 To UBound(listArray)
        Set xPTable = Worksheets("SheetName").PivotTables(listArray(i))
        Set xPFile = xPTable.PivotFields("FieldName")
        'MsgBox (listArray(i))
        xStr = Target.Text
        xPFile.ClearAllFilters
        xPFile.CurrentPage = xStr
    Next
        Application.ScreenUpdating = True
End Sub
Цей коментар був мінімізований модератором на сайті
Як зробити, щоб звідна таблиця застосовувала відразу 2 фільтра з 2хразових ячеек? а не 1 як в прикладі?
Цей коментар був мінімізований модератором на сайті
Привіт Алексей,

Будь ласка, перевірте, чи код VBA в цьому коментарі # 38754 може допомогти.
Цей коментар був мінімізований модератором на сайті
Можна чи сослаться замість ячейки H6 на ячейку на другому листі? як це зробити? подскажите пожалуйста.
Цей коментар був мінімізований модератором на сайті
Привіт Алексей,

Вам не потрібно змінювати код, просто додайте код VBA на аркуш клітинки, на яку ви хочете посилатися.
Наприклад, якщо ви хочете відфільтрувати зведену таблицю під назвою "Зведена таблиця1Sheet2 на основі значення комірки H6 in Sheet3клацніть правою кнопкою миші Sheet3 вкладку аркуш, натисніть Переглянути код у меню, що відкривається правою кнопкою миші, а потім додайте код до Аркуш3 (Код) вікна.
There are no comments posted here yet
Залишайте свої коментарі
Публікація як гість
×
Оцініть цю публікацію:
0   Персонажі
Рекомендовані місця

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

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