Pivot items löschen - performance
10.11.2008 10:01:00
lobby007
ich habe mehrere Pivot-Dateien bei denen aus Platzgründen immer die nicht mehr benötigten Pivot-Items gelöscht werden sollen. (Ca. 1000 Zeilen und 25 Spalten je Datei bei 2 Pivottabellen je Datei).
Das Makro sieht so aus:
Sub Macro1()
ActiveWorkbook.RefreshAll
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.PivotFields
For Each pi In pf.PivotItems
If pi.RecordCount = 0 And _
Not pi.IsCalculated Then
pi.Delete
End If
Next
Next
Next
Next
'Sheets("Summe").Range("G1") = "Pivot-Data: " & Now
' Sheets("Summe").Range("J1") = "Saved: " & Now
ActiveWorkbook.Save
End Sub
Das mit dem Pivot-Items löschen geht aber es ist unglaublich langsam: mehr als 15 Minuten je Excel-Datei! Ich habe 9 von diesen Dateien. Ich mache das alles per vbs im Nachtlauf aber manchmal muß es auch zwischendurch sein.
Wie kann man das Makro beschleunigen? (Screenupdating geht glaube ich nicht?)
Gruß lobby007