KuMoo's Blog

Sub DeleteMissingItems2002All()
'防止数据透视表中显示无用的数据项
'在 Excel 2002 或更高版本中
'如果无用的数据项已经存在,
  '运行这个宏可以更新
Dim pt As PivotTable
Dim ws As Worksheet

For Each ws In ActiveWorkbook.Worksheets
  For Each pt In ws.PivotTables
    pt.PivotCache.MissingItemsLimit = xlMissingItemsNone
  Next pt
Next ws

End Sub

编写程序清除原有的数据项-- Excel 97/Excel 2000
在较早的Excel版本中, 运行下列代码可以清除数据透视表下拉表的原有数据项.

Sub DeleteOldItemsWB()
'清除数据透视表中无用的数据项
' 单位MSKB (202232)
Dim ws As Worksheet
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
On Error Resume Next
For Each ws In ActiveWorkbook.Worksheets
  For Each pt In ws.PivotTables
    pt.RefreshTable
    For Each pf In pt.VisibleFields
      If pf.Name <> "Data" Then
        For Each pi In pf.PivotItems
          If pi.RecordCount = 0 And _
            Not pi.IsCalculated Then
            pi.Delete
          End If
        Next
      End If
    Next
  Next
Next
End Sub