Приходится работать со сводными в VBA. Есть такой код, который фильтрует поле сводной
[vba]
Код
Private Sub SetPivotItemsFilter(ByRef Pivot As PivotTable, _ ByRef PivotField As PivotField, _ ParamArray ItemNames() As Variant) Dim PivotItem As PivotItem Dim ItemName As Variant
Pivot.ManualUpdate = True
For Each PivotItem In PivotField.PivotItems PivotItem.Visible = False
For Each ItemName In ItemNames If StrComp(PivotItem.Name, ItemName, vbTextCompare) = 0 Then PivotItem.Visible = True Exit For End If Next Next
Pivot.ManualUpdate = False Pivot.Update End Sub
[/vba]
Проблема в том, что, если сводная большая, из-за "идет расчет сводной" он работает долго.
Приходится работать со сводными в VBA. Есть такой код, который фильтрует поле сводной
[vba]
Код
Private Sub SetPivotItemsFilter(ByRef Pivot As PivotTable, _ ByRef PivotField As PivotField, _ ParamArray ItemNames() As Variant) Dim PivotItem As PivotItem Dim ItemName As Variant
Pivot.ManualUpdate = True
For Each PivotItem In PivotField.PivotItems PivotItem.Visible = False
For Each ItemName In ItemNames If StrComp(PivotItem.Name, ItemName, vbTextCompare) = 0 Then PivotItem.Visible = True Exit For End If Next Next
Pivot.ManualUpdate = False Pivot.Update End Sub
[/vba]
Проблема в том, что, если сводная большая, из-за "идет расчет сводной" он работает долго.
ну если "поячеешно", то словарик какой-нибудь что ли [vba]
Код
Sub ert() Dim pvt As PivotTable, pvtField As PivotField, arrNames$(1) Set pvt = ActiveSheet.PivotTables("СводнаяТаблица1") Set pvtField = pvt.PivotFields("Наим") arrNames(0) = "ыва": arrNames(1) = "sdf" Call SetPivotItemsFilter(pvt, pvtField, arrNames()) End Sub
Private Sub SetPivotItemsFilter(pvt As PivotTable, _ pvtField As PivotField, _ ItemNames() As String) Dim pvtItem As PivotItem, x pvtField.ClearAllFilters 'Pivot.ManualUpdate = True ' это типа ScreenUpdating? With CreateObject("Scripting.Dictionary") .CompareMode = 1 For Each x In ItemNames() .Item(x) = Empty Next x For Each pvtItem In pvtField.PivotItems If Not .Exists(pvtItem.Name) Then pvtItem.Visible = False Next End With End Sub
[/vba] вообще, в сводных наверняка есть что-то вроде фильтра с массивом в кач-ве критериев, и все это запишется в одну строку, надо только поискать
ну если "поячеешно", то словарик какой-нибудь что ли [vba]
Код
Sub ert() Dim pvt As PivotTable, pvtField As PivotField, arrNames$(1) Set pvt = ActiveSheet.PivotTables("СводнаяТаблица1") Set pvtField = pvt.PivotFields("Наим") arrNames(0) = "ыва": arrNames(1) = "sdf" Call SetPivotItemsFilter(pvt, pvtField, arrNames()) End Sub
Private Sub SetPivotItemsFilter(pvt As PivotTable, _ pvtField As PivotField, _ ItemNames() As String) Dim pvtItem As PivotItem, x pvtField.ClearAllFilters 'Pivot.ManualUpdate = True ' это типа ScreenUpdating? With CreateObject("Scripting.Dictionary") .CompareMode = 1 For Each x In ItemNames() .Item(x) = Empty Next x For Each pvtItem In pvtField.PivotItems If Not .Exists(pvtItem.Name) Then pvtItem.Visible = False Next End With End Sub
[/vba] вообще, в сводных наверняка есть что-то вроде фильтра с массивом в кач-ве критериев, и все это запишется в одну строку, надо только поискатьnilem
Друзья, не могли бы Вы прокомментировать код, который указали выше (если не трудно)
[vba]
Код
Sub ert() Dim pvt As PivotTable, pvtField As PivotField, arrNames$(1) Set pvt = ActiveSheet.PivotTables("СводнаяТаблица1") Set pvtField = pvt.PivotFields("Наим") arrNames(0) = "ыва": arrNames(1) = "sdf" Call SetPivotItemsFilter(pvt, pvtField, arrNames()) End Sub
Private Sub SetPivotItemsFilter(pvt As PivotTable, _ pvtField As PivotField, _ ItemNames() As String) Dim pvtItem As PivotItem, x pvtField.ClearAllFilters 'Pivot.ManualUpdate = True ' это типа ScreenUpdating? With CreateObject("Scripting.Dictionary") .CompareMode = 1 For Each x In ItemNames() .Item(x) = Empty Next x For Each pvtItem In pvtField.PivotItems If Not .Exists(pvtItem.Name) Then pvtItem.Visible = False Next End With End Sub
[/vba]
Также не могу понять, для чего ArrNames$, почему он просто идет через запятую. Так же и для х (просто идет через запятую)
Друзья, не могли бы Вы прокомментировать код, который указали выше (если не трудно)
[vba]
Код
Sub ert() Dim pvt As PivotTable, pvtField As PivotField, arrNames$(1) Set pvt = ActiveSheet.PivotTables("СводнаяТаблица1") Set pvtField = pvt.PivotFields("Наим") arrNames(0) = "ыва": arrNames(1) = "sdf" Call SetPivotItemsFilter(pvt, pvtField, arrNames()) End Sub
Private Sub SetPivotItemsFilter(pvt As PivotTable, _ pvtField As PivotField, _ ItemNames() As String) Dim pvtItem As PivotItem, x pvtField.ClearAllFilters 'Pivot.ManualUpdate = True ' это типа ScreenUpdating? With CreateObject("Scripting.Dictionary") .CompareMode = 1 For Each x In ItemNames() .Item(x) = Empty Next x For Each pvtItem In pvtField.PivotItems If Not .Exists(pvtItem.Name) Then pvtItem.Visible = False Next End With End Sub
[/vba]
Также не могу понять, для чего ArrNames$, почему он просто идет через запятую. Так же и для х (просто идет через запятую)Gamid
Сообщение отредактировал Serge_007 - Воскресенье, 13.12.2015, 19:30