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

Question

Я пытаюсь обновить сводную таблицу powerpivot на основе двух значений ячейки. Конечный пользователь будет использовать выпадающий список в ячейках C17 и C18 для получения значения в ячейке G17 и G18 (через некоторый расчет excel). Pivot Table будет обновляться на основе Cell G17 и G18.

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

Sub Worksheet_SelectionChange(ByVal Target As Range) 

If Intersect(Target, Range("G17:G19")) Is Nothing Then Exit Sub 

Dim pt As PivotTable 
Dim FieldHr As PivotField 
Dim FieldEndingMin As PivotField 
Dim NewHr As String 
Dim NewMin As String 

Set pt = Worksheets("Calculator").PivotTables("Table1") 
Set FieldHr = pt.PivotFields("Hr") 
NewHr = Worksheets("Calculator").Range("G17").Value 
Set FieldEndingMin = pt.PivotFields("Ending Min") 
NewMin = Worksheets("Calculator").Range("G18").Value 

With pt 
FieldHr.ClearAllFilters 
FieldHr.CurrentPage = NewHr 
FieldEndingMin.ClearAllFilters 
FieldEndingMin.CurrentPage = NewMin 
pt.RefreshTable 
End With 

End Sub 

Answer 1

я переехал код из Worksheet_SelectionChange в Worksheet_Change события.

Я добавил Union из диапазона, ячейки C17: C18 с ячейками G17: G19 (требуется G19 в вашем сообщении, которое вы упомянули G17: G18).

Private Sub Worksheet_Change(ByVal Target As Range) 

If Intersect(Target, Union(Range("C17:C18"), Range("G17:G19"))) Is Nothing Then Exit Sub 

Dim pt     As PivotTable 
Dim FieldHr   As PivotField 
Dim FieldEndingMin  As PivotField 
Dim NewHr    As String 
Dim NewMin    As String 

Set pt = Worksheets("Calculator").PivotTables("Table1") 
Set FieldHr = pt.PivotFields("Hr") 
NewHr = Worksheets("Calculator").Range("G17").Value 
Set FieldEndingMin = pt.PivotFields("Ending Min") 
NewMin = Worksheets("Calculator").Range("G18").Value 

With FieldHr 
    .ClearAllFilters 
    .CurrentPage = NewHr 
End With 

With FieldEndingMin 
    .ClearAllFilters 
    .CurrentPage = NewMin 
End With 

pt.RefreshTable 

End Sub