MyTetra Share
Делитесь знаниями!
Обновление списков сводной таблицы
16.03.2019
23:43
Текстовые метки: vba, pt,pivot,PivotItems,Обновление списков сводной таблицы
Раздел: !Закладки - VBA - Сводные

При работе со сводными таблицами, сохраненными в качестве отчетов и использующих обновляемые исходные данные, выпадающие списки полей могут показывать устаревшие несуществующие в текущем контексте значения. Эта недоработка тянется с момента появления интерфейса сводных таблиц до версии Excel 2007. Исправить эту ситуацию можно, используя программный код VBA.

Запускать процедуру ClearUnusedPivotItems можно сразу после обновления данных. В качестве параметра передается объект PivotTable. Тип Object в примере использован для лучшей адаптации к внешним приложениям: например, для запуска из Microsoft Access или через VB-script.


Private Sub ClearUnusedPivotItems(oPivotTable As Object)

Dim oPivotField As Object

Dim oPivotItem As Object

Dim nIdx As Long

Dim bCalc As Boolean

For Each oPivotField In oPivotTable.RowFields

If oPivotField.Value <> "Data" Then

nIdx = 1

Do While (nIdx <= oPivotField.PivotItems.Count)

Set oPivotItem = oPivotField.PivotItems(nIdx)

On Error GoTo Err_

If oPivotItem.IsCalculated Then

nIdx = nIdx + 1

Else

oPivotItem.Delete

End If

On Error GoTo 0

Loop

End If

Next

For Each oPivotField In oPivotTable.ColumnFields

If oPivotField.Value <> "Data" Then

nIdx = 1

Do While (nIdx <= oPivotField.PivotItems.Count)

Set oPivotItem = oPivotField.PivotItems(nIdx)

On Error GoTo Err_

If oPivotItem.IsCalculated Then

nIdx = nIdx + 1

Else

oPivotItem.Delete

End If

On Error GoTo 0

Loop

End If

Next

For Each oPivotField In oPivotTable.PageFields

nIdx = 1

Do While (nIdx <= oPivotField.PivotItems.Count)

Set oPivotItem = oPivotField.PivotItems(nIdx)

On Error GoTo Err_

If oPivotItem.IsCalculated Then

nIdx = nIdx + 1

Else

oPivotItem.Delete

End If

On Error GoTo 0

Loop

Next

Exit Sub

Err_:

nIdx = nIdx + 1

Resume Next

End Sub

Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования