Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
740to744
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
740to744
740to744
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Pivottabelle säubern mit VBA

Pivottabelle säubern mit VBA
06.03.2006 10:41:57
maze
Hallo Forumsmitglieder,
kann mir bitte jemand bei diesem Makro helfen. Er löscht überflüssige Einträge in den Pivotabellen. Er soll jetzt 7 Spalten überprüfen und nicht bloß eine, die Meldung darin brauche ich auch nicht mehr. Ich muß von Hand immer die nächste Spalte anpassen, das kostet Zeit.
RowFields(2)bis Row Fields(8)in einem durch wäre mein Wunsch!!

Sub Pivot_cleaner2()
Dim intCounter As Integer
Dim intAnzahlRowFeldItems As Integer
intAnzahlRowFeldItems = ActiveSheet.PivotTables("PivotTable"). _
RowFields(2).PivotItems.Count
With ActiveSheet.PivotTables("PivotTable").RowFields(2)
For intCounter = intAnzahlRowFeldItems To 1 Step -1
If .PivotItems(intCounter).RecordCount Then
MsgBox .PivotItems(intCounter).Name & " kommt " & _
.PivotItems(intCounter).RecordCount & _
"-mal in der Tabelle vor!"
Else
MsgBox .PivotItems(intCounter).Name & " kommt " & _
" nicht mehr in der Tabelle vor und wird gelöscht!"
.PivotItems(intCounter).Delete
End If
Next intCounter
End With
End Sub

Gruß
Matthias

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Pivottabelle säubern mit VBA
06.03.2006 11:04:32
Luschi
Hallo Matthias,
versuch's mal so:
Sub Pivot_cleaner2()
Dim intCounter As Integer
Dim intAnzahlRowFeldItems As Integer, _
i As Integer
For i = 2 To 8
intAnzahlRowFeldItems = ActiveSheet.PivotTables("PivotTable"). _
RowFields(i).PivotItems.Count
With ActiveSheet.PivotTables("PivotTable").RowFields(i)
For intCounter = intAnzahlRowFeldItems To 1 Step -1
If .PivotItems(intCounter).RecordCount = 0 Then
.PivotItems(intCounter).Delete
End If
Next intCounter
End With
Next i
End Sub
Gruß von Luschi
aus klein-Paris
supero<<<<< läuft super
06.03.2006 11:55:00
maze
Dank Luschi aus klein Paris
Gruß
Matthias
Anzeige

306 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige