Willkommen

Pivottabelle

Spezialfilter

Formeln

Zellformate

Bedingte Formate

Gültigkeit

Programmierung

UDF - Funktionen

Tipps & Tricks

Webabfrage

Fehlersuche

Farbindex

Shortcuts

Limitationen

Downloads

Links

Kontakt

Disclaimer

Impressum

Alte Pivoteinträge entfernen
Wer oft mit Pivottabellen arbeitet kennt das Problem. Werden alte Datensätze in der Datenquelle bei bestehenden Pivottabellen durch neue ersetzt, zeigt das Dropdown der Pivottabelle immer noch die alten, nicht mehr existierenden Datensätze an.
 
Hier im Beispiel wurde der Name "Mustermann" gegen "Müller" ersetzt. Im Dropdown ist aber immer noch "Mustermann" zu sehen. Hat man viele solcher "Leichen", erschwert es das gezielte Auswählen gewünschter Datensätze.
 
 
 
 
Nachfolgend nun ein Code, den ich freundlicher Weise von MVP Thomas Ramel ( Schweiz ) für meine Homepage bekommen habe.
Bei Codeausführung werden in allen Pivottabellen der aktiven Mappe alte Einträge gelöscht.
 
 
Code für ein allgemeines Modul:
 
 
Sub DeleteOldPivotItemsWB()
'**************************************************************
'Code für ein allgemeines Modul
'Quelle: Thomas Ramel
'löschen von nicht mehr verwendeten Einträgen in Pivot-Tabellen
'basierend auf MSKB (Q202232)
'**************************************************************
Dim wS                      As Worksheet
Dim pt                        As PivotTable
Dim pf                        As PivotField
Dim pi                        As PivotItem
 
    If Application.Version < 10 Then
        'Für alle älteren Excel-Versionen
        For Each wS In ActiveWorkbook.Worksheets
            For Each pt In wS.PivotTables
                pt.RefreshTable
                pt.ManualUpdate = True
                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
                pt.ManualUpdate = False
            Next
        Next
    Else
        'Als Alternative ab xl2002
        For Each wS In ActiveWorkbook.Worksheets
            For Each pt In wS.PivotTables
                pt.ManualUpdate = True
                pt.PivotCache.MissingItemsLimit = xlMissingItemsNone
                pt.RefreshTable
                pt.ManualUpdate = False
            Next pt
        Next wS
    End If
End Sub