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

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

Если вы хотите связать фильтр сводной таблицы с определенной ячейкой и настроить фильтрацию сводной таблицы на основе значения ячейки, метод, описанный в этой статье, может вам помочь.

Свяжите фильтр сводной таблицы с определенной ячейкой с кодом VBA


Свяжите фильтр сводной таблицы с определенной ячейкой с кодом VBA

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

Возьмем в качестве примера приведенную ниже сводную таблицу. Поле фильтра в сводной таблице называется Категория, и включает в себя два значения:Расходы(Основной ключ) и ПРОДАЖИ». После связывания фильтра сводной таблицы с ячейкой значения ячеек, которые вы примените к фильтру сводной таблицы, должны быть «Расходы» и «Продажи».

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, затем соответствующие данные в сводной таблице будут отфильтрованы на основе существующего значения. Смотрите скриншот:

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


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

Компания Выбрать определенные ячейки полезности Kutools for Excel может помочь вам быстро выбрать целые строки на основе значения ячейки в столбце Certian в Excel, как показано ниже. После выбора всех строк на основе значения ячейки вы можете вручную переместить или скопировать их в новое место в Excel.
Скачайте и попробуйте прямо сейчас! (30-дневная бесплатная трасса)


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


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

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

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

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

  • Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Издатель, доступ, Visio и проект.
  • Открывайте и создавайте несколько документов на новых вкладках одного окна, а не в новых окнах.
  • Повышает вашу продуктивность на 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




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

Dim xPTabled как сводная таблица
Dim xPFiled As PivotField

Dim xStr как строка



On Error Resume Next

'리스트 만들기
Dim listArray() как вариант
listArray = Массив ("Сводная таблица1", "Сводная таблица2", "Сводная таблица3")



Если Intersect(Target, Range("E1")) ничего не значит, тогда выйдите из Sub
Приложение.ScreenUpdating = False

Для 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
Этот комментарий был сведен к минимуму модератором на сайте
Ciao, sto provando a fare lo stesso esempio per far in modo che il filtro della pivot si setti sul valore dellacella,
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 (это должно быть в пределах диапазона)

В этом своде я пытаюсь изменить фильтр для столбцов, у меня ничего нет в области фильтра в меню «Поля сводной таблицы».

мой код:

Private Sub Worksheet_Change (ByVal Target As Range)
'Обновить Extendoffice 20180702
Dim xPTable как сводная таблица
Dim xPFile как PivotField
Dim xStr как строка
On Error Resume Next
Если Intersect(Target, Range("O26")) ничего не значит, тогда выйдите из Sub
Приложение.ScreenUpdating = False
Установите xPTable = Рабочие листы («Лист расчета»). Сводные таблицы («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 ссылки на ячейки):

Private Sub Worksheet_Change (ByVal Target As Range)
Dim I как целое число
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("Номер недели"). _
Очистить все фильтры

Если xFilterStr1 = "" And xFilterStr2 = "" And yFilterstr1 = "" And yfilterstr2 = "" Затем выйдите из 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 = Истина

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 To xCount
Если I <> xFilterStr1 И 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 To yCount
Если I <> yFilterstr1 И 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




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

Dim xPTabled как сводная таблица
Dim xPFiled As PivotField

Dim xStr как строка



On Error Resume Next

'리스트 만들기
Dim listArray() как вариант
listArray = Массив ("Сводная таблица1", "Сводная таблица2", "Сводная таблица3")



Если Intersect(Target, Range("E1")) ничего не значит, тогда выйдите из Sub
Приложение.ScreenUpdating = False

Для 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. Есть ли способ обойти это?

спасибо
Этот комментарий был сведен к минимуму модератором на сайте
Здравствуйте, СТ.
Предположим, ваше целевое значение находится в 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 изменяется, сводная таблица сбрасывается до отсутствия фильтра. Не могли бы вы помочь мне в этом?
Этот комментарий был сведен к минимуму модератором на сайте
Привет СТ,
Я не совсем понимаю, что вы имеете в виду. В вашем случае значение целевой ячейки 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 (Код) окно.
Здесь еще нет комментариев
Оставляйте свои комментарии
Публикация как гость
×
Оценить этот пост:
0   Характеристики
Предлагаемые места

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

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