привет Франк
Сорри не может тебе в этом помочь.

Привет Джери,
Извините, не могу вам в этом помочь. Добро пожаловать, чтобы разместить любой вопрос на нашем форуме: 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

Привет, Гилмар Алвес,
Извините, не могу вам в этом помочь. Добро пожаловать, чтобы разместить любой вопрос на нашем форуме: https://www.extendoffice.com/forum.html чтобы получить дополнительную поддержку Excel от профессионалов Excel или других поклонников Excel.

Здравствуйте,
Вы получили сообщение об ошибке? Мне нужно знать больше о вашей проблеме, например, о вашей версии Excel. И если вы не возражаете, попробуйте создать свои данные в новой книге и повторить попытку, или сделайте снимок экрана со своими данными и загрузите его сюда.

Привет Джастин,
Вы получили сообщение об ошибке? Мне нужно знать более конкретно о вашей проблеме.
Перед применением кода не забудьте изменить "имя листа,имя сводной таблицы,имя фильтра сводной таблицы"и ячейка вы хотите отфильтровать сводную таблицу на основе (см. Скриншот).

Привет, Кристал,

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

Название сводки: 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 или прикрепленную книгу.
Не возражаете ли вы создать новую книгу и попробовать код еще раз?

Привет, Кристал,

Прикрепил скриншот сводки, красное поле — это фильтр, который я хотел бы изменить на основе значения ячейки.

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

Благодаря,

Джастин

Привет Джастин,
Извините, я не видел скриншот, который вы прикрепили на странице. Возможно, на странице какая-то ошибка.
Если вам все еще нужно решить проблему, напишите мне по адресу 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

Привет, 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

Здравствуйте, СТ.
Предположим, ваше целевое значение находится в 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

Привет СТ,
Я не совсем понимаю, что вы имеете в виду. В вашем случае значение целевой ячейки D3 используется для фильтрации сводной таблицы. Формула в целевой ячейке D3 ссылается на значения ячеек A15, B15 и C15, которые будут меняться в соответствии со значениями в опорных ячейках. При изменении любого значения в A15, B15 и C15 сводная таблица будет автоматически отфильтрована, если значение в целевой ячейке соответствует условиям фильтрации сводной таблицы. Если значение в целевой ячейке не соответствует критериям фильтрации сводной таблицы, сводная таблица будет автоматически сброшена до отсутствия фильтрации.

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

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

Привет Алексей,

Пожалуйста, проверьте, является ли код VBA в этом комментарии #38754 может помочь.

Привет Алексей,

Вам не нужно изменять код, просто добавьте код VBA на рабочий лист ячейки, на которую вы хотите сослаться.
Например, если вы хотите отфильтровать сводную таблицу с именем "Сводная таблица1"В Sheet2 на основе значения ячейки H6 in Sheet3, пожалуйста, щелкните правой кнопкой мыши Sheet3 вкладку рабочего листа щелкните Просмотреть код из контекстного меню, а затем добавьте код в Лист3 (Код) окно.