VBA-Code verbessern für Pivot-Seitenfelder
Frank Vellner
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
Thomas Ramel
Frank Vellner schrieb am 06.05.2009
> beim unten aufgef嚙篁rten 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嚙緝de ich mir w嚙緯schen, 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嚙締len, 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嚙編sen
Thomas Ramel
--
- MVP f嚙緝 Microsoft-Excel -
[Vista Ultimate SP-1 / xl2007 SP-1]
Frank Vellner
> 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.
danke f�r die Anf�hrungsstriche um das 'nur' ;-)
Tja, und dein Code funktioniert nat�rlich super und rasend schnell.
Siehst dann am End immer so sch�n einfach und �bersichtlich aus... das
macht's so genial.
Ganz herzlichen Dank f�r deine M�he und ein sch�nes Wochenende w�nscht
der Frank