MyTetra Share
Делитесь знаниями!
Обновление списков сводной таблицы
Время создания: 12.10.2019 20:12
Текстовые метки: pt, pivot, PivotItems, Обновление списков сводной таблицы
Раздел: !Закладки - VBA - Excel - Сводные
Запись: adgaver/mytetra_base_New/master/base/15045254996nlmnz3kgc/text.html на raw.githubusercontent.com

При работе со сводными таблицами, сохраненными в качестве отчетов и использующих обновляемые исходные данные, выпадающие списки полей могут показывать устаревшие несуществующие в текущем контексте значения. Эта недоработка тянется с момента появления интерфейса сводных таблиц до версии 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.55
Яндекс индекс цитирования