VBA-Code verbessern für Pivot-Seitenfelder

06/05/2009 - 11:06 von Frank Vellner | Report spam
Liebe NG,

beim unten aufgeführten Makro werden alle Pivot-Tabellen einer
Arbeitsmappe auf die selben Seitenfelder - der gerade aktiven PT -
eingestellt. Das funktioniert soweit prima.

Es bricht jedoch ab, wenn ein Seitenfeld der aktiven PT in irgendeiner
zu bearbeitenden nicht vorhanden ist. Da würde ich mir wünschen, wenn
es etwas toleranter arbeitet: Nur wenn das Seitenfeld in der anderen PT
vorhanden ist, soll es wie bei der aktiven engestellt werden -
ansonsten soll es ignoriert werden.

Damit kein falscher Verdacht aufkommt: Der Code ist natürlich
eigentlich nicht von mir sondern von Thomas Ramel (Ursprungsname
PivotTable_Gleich()). Er bezog sich jedoch nur auf ein Tabellenblatt
und ich habe ihn auf die ganze Mappe erweitert (erneut mit einem andern
Thomas-Code, den ich reingemixt habe):

Sub Pivot_SeitenfeldGleichUeberall()

Dim ptActive As PivotTable
Dim pt As PivotTable
Dim pf As PivotField
Dim wks As Worksheet

On Error Resume Next
Set ptActive = ActiveCell.PivotTable
On Error GoTo 0
If Not ptActive Is Nothing Then
On Error GoTo ErrorHandler
Application.EnableEvents = False
For Each wks In ActiveWorkbook.Worksheets
For Each pt In wks.PivotTables
If pt.Name <> ptActive.Name Then
For Each pf In ptActive.PageFields
pt.PivotFields(pf.Value).CurrentPage = _
ptActive.PivotFields(pf.Value).CurrentPage.Value
Next pf
End If
Next pt
Next wks
Else
MsgBox "Bitte zuerst eine Zelle in einer PT markieren"
End If

ResumePoint:
Application.EnableEvents = True
Exit Sub

ErrorHandler:
If Err.Number = 1004 Then
'MsgBox (wks.Name & pt.Name)
wks.Activate
pt.TableRange1.Select
End If
Resume ResumePoint:
End Sub

Viele Grüße
Frank
 

Lesen sie die antworten

#1 Thomas Ramel
08/05/2009 - 06:35 | Warnen spam
Grüezi Frank

Frank Vellner schrieb am 06.05.2009

beim unten aufgeführten Makro werden alle Pivot-Tabellen einer
Arbeitsmappe auf die selben Seitenfelder - der gerade aktiven PT -
eingestellt. Das funktioniert soweit prima.

Es bricht jedoch ab, wenn ein Seitenfeld der aktiven PT in irgendeiner
zu bearbeitenden nicht vorhanden ist. Da würde ich mir wünschen, wenn
es etwas toleranter arbeitet: Nur wenn das Seitenfeld in der anderen PT
vorhanden ist, soll es wie bei der aktiven engestellt werden -
ansonsten soll es ignoriert werden.



Da braucht es eigentlich 'nur' eine weitere Schleife, in der die
Seitenfelder der anderen PT's durchlaufen werden und der Abgleich nur dann
vorgenommen wird, wenn das Feld auch in der anderen PT enthalten ist.

Die folgenden Zeilen sollten dies erfüllen, denke ich:

Sub Pivot_SeitenfeldGleichUeberall()
Dim ptActive As PivotTable
Dim pt As PivotTable
Dim pf1 As PivotField
Dim pf2 As PivotField
Dim wks As Worksheet

On Error Resume Next
Set ptActive = ActiveCell.PivotTable
On Error GoTo 0
If Not ptActive Is Nothing Then
On Error GoTo ErrorHandler
Application.EnableEvents = False
For Each wks In ActiveWorkbook.Worksheets
For Each pt In wks.PivotTables
If pt.Name <> ptActive.Name Then
For Each pf1 In ptActive.PageFields
For Each pf2 In pt.PageFields
If pf1.Name = pf2.Name Then
pf2.CurrentPage = _
pf1.CurrentPage.Value
End If
Next pf2
Next pf1
End If
Next pt
Next wks
Else
MsgBox "Bitte zuerst eine Zelle in einer PT markieren"
End If

ResumePoint:
Application.EnableEvents = True
Exit Sub

ErrorHandler:
If Err.Number = 1004 Then
'MsgBox (wks.Name & pt.Name)
wks.Activate
pt.TableRange1.Select
End If
Resume ResumePoint:
End Sub



Mit freundlichen Grüssen
Thomas Ramel

- MVP für Microsoft-Excel -
[Vista Ultimate SP-1 / xl2007 SP-1]

Ähnliche fragen