Как управлять таблицами Excel PIVOT из значений ячеек с помощью VBA

103
13

Я пытаюсь обновить базу сводной таблицы по двум значениям ячейки. Конечный пользователь вводит значение в ячейке B4 (регион) и значение в ячейке B5 (отдел). Сводная таблица обновит базу по этим значениям.

Я нашел код ниже, но только позволяет ссылаться на 1 значение ячейки. Не знаете, как изменить его для двух значений ячейки.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'This line stops the worksheet updating on every change, it only updates when cell
'B4 or B5 is touched

If Intersect(Target, Range("B4:B5")) Is Nothing Then Exit Sub

'Set the Variables to be used
Dim pt As PivotTable
Dim Field As PivotField
Dim NewCat As String

'Here you amend to filter your data
Set pt = Worksheets("Sheet1").PivotTables("PivotTable1")
Set Field = pt.PivotFields("Region")
NewCat = Worksheets("Sheet1").Range("B4").Value

'This updates and refreshes the PIVOT table
With pt
Field.ClearAllFilters
Field.CurrentPage = NewCat
pt.RefreshTable
End With

End Sub

спросил(а) 2014-09-23T19:08:00+04:00 5 лет, 9 месяцев назад
1
Решение
66

Я смог использовать приведенный ниже код для обновления фильтров таблицы Pivot. Надеюсь, это поможет другим.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'This line stops the worksheet updating on every change, 'it only updates when cell'B4
'or B5 is touched

If Intersect(Target, Range("B4:B5")) Is Nothing Then Exit Sub

'Set the Variables to be used
Dim pt As PivotTable
Dim FieldRegion As PivotField
Dim FieldDept As PivotField
Dim NewRegion As String
Dim NewDept As String

'Amend here to filter your data
Set pt = Worksheets("Sheet1").PivotTables("PivotTable1")
Set FieldRegion = pt.PivotFields("Region")
Set FieldDept = pt.PivotFields("Department")
NewRegion = Worksheets("Sheet1").Range("B4").Value
NewDept = Worksheets("Sheet1").Range("B5").value

'This updates and refreshes the PIVOT table
With pt
FieldRegion.ClearAllFilters
FieldRegion.CurrentPage = NewRegion
FieldDept.ClearAllFilters
FieldDept.CurrentPage = NewDept
pt.RefreshTable
End With

End Sub

ответил(а) 2014-09-26T18:08:00+04:00 5 лет, 9 месяцев назад
Ваш ответ
Введите минимум 50 символов
Чтобы , пожалуйста,
Выберите тему жалобы:

Другая проблема