Filter in diagrammen automatisieren

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Filter in diagrammen automatisieren
von: Spenski
Geschrieben am: 18.04.2015 17:20:08

Hallo und erstmal ein schönes Wochenende :D
Im ersten Schritt möchte ich fragen ob mein anliegen überhaupt möglich ist , danach würd ich gerne eine Beispiel Datei nachbauen und sie bereitstellen.
Ich habe auf mehreren tabellenblättern das selbe Pivot Chart kopiert (also alle die selbe datenquelle).
Im ersten Achsenfeld gibt es die punkte 1-10. Jetzt möchte ich , wenn ich zb. das erste Blattaufrufe, das nur punkt 1 im Achsenfeld gefiltert wird. wenn ich Blatt 2 aufrufe punkt 2 im Achsenfeld gefiltert wird usw. Der zu Filternde Wert würde immer in B2 stehen.
geht sowas?
mfg und ein wunderbares Wochenende
Christian

Bild

Betrifft: AW: Filter in diagrammen automatisieren
von: Nepumuk
Geschrieben am: 18.04.2015 17:40:54
Hallo,
klar. Als Beispiel genügt eine kleine Tabelle und 2 Diagramme.
Gruß
Nepumuk

Bild

Betrifft: AW: Filter in diagrammen automatisieren
von: Spenski
Geschrieben am: 18.04.2015 17:51:32
hu super danke für die antwort
https://www.herber.de/bbs/user/97152.xlsx
geht das auch für das legendenfeld??? (sheet 3-4 I1:I3)
möchte später auch nur die letzten 5 Wochen anzeigen lassen sonst wird das zu viel.
danke

Bild

Betrifft: AW: Filter in diagrammen automatisieren
von: Nepumuk
Geschrieben am: 18.04.2015 18:24:58
Hallo,
in das Modul der Diagrammtabelle:

Option Explicit

Private Sub Worksheet_Activate()
    Dim objPivotItem As PivotItem
    Dim lngIndex As Long
    Application.ScreenUpdating = False
    EnableCalculation = False
    With ChartObjects(1).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1")
        For Each objPivotItem In .PivotItems
            objPivotItem.Visible = True
        Next
        For Each objPivotItem In .PivotItems
            With objPivotItem
                .Visible = CDbl(.Value) = Cells(1, 2).Value
            End With
        Next
    End With
    With ChartObjects(1).Chart.PivotLayout.PivotTable.PivotFields("KW")
        For Each objPivotItem In .PivotItems
            objPivotItem.Visible = True
        Next
        For lngIndex = 1 To .PivotItems.Count - 3 '3 ist die Anzahl der angezeigten KW's !!!!!!!!!!!!
            .PivotItems.Item(lngIndex).Visible = False
        Next
    End With
    EnableCalculation = True
    Application.ScreenUpdating = True
End Sub

Gruß
Nepumuk

Bild

Betrifft: AW: Filter in diagrammen automatisieren
von: Spenski
Geschrieben am: 18.04.2015 18:53:22
Danke Nepumuk
das ist genau das was ich gesucht habe...
habe aber noch einen kleinen Fehler gefunden. Hab ich aber auch erst beim testen gemerkt.
wenn es zu einem punkt in Ebene 1 keine Daten gibt (in der BSP Datei zb 3 und 4 dann bekomm ich n fehler angezeigt weil er zu 3 und 4 nix findet. ist verständlich aber habs vergessen zu erwähnen.
sry und danke

Bild

Betrifft: AW: Filter in diagrammen automatisieren
von: Spenski
Geschrieben am: 18.04.2015 20:58:33
hab das jetzt mal in meine Originaldatei eingebaut und bekomm da komischerweise einen laufzeitfehler 13 angezeigt.
in dieser zeile : .Visible = CDbl(.Value) = Cells(1, 2).Value
in der Datei ist sonst kein VBA eingebaut daher weiss ich nicht wirklich woran das liegt, in der testdatei funktionierte es ja auch und es sind die selben Daten gewesen.
die Datei ist leider >300kb habs bei fileupload hochgeladen.
http://www.file-upload.net/download-10550229/WPA_STOPS.xlsm.html
verstehe aber wenn das jemand nicht öffnen mag
mfg
christian

Bild

Betrifft: AW: Filter in diagrammen automatisieren
von: Nepumuk
Geschrieben am: 18.04.2015 21:12:14
Hallo,
da sind in der Spalte wie in der Zeile leere dabei. Irgendwas stimmt da in der Tabelle nicht. Den Fehler kannst du beheben indem du diese Zeile:
.Visible = CDbl(.Value) = Cells(1, 13).Value
so änderst:
.Visible = Val(.Value) = Cells(1, 13).Value
Gruß
Nepumuk

Bild

Betrifft: AW: Filter in diagrammen automatisieren
von: Spenski
Geschrieben am: 18.04.2015 23:52:25
also nochmal danke für deine Unterstützung. den laufzeitfehler hab ich wegbekommen.
jetzt versuche ich 3 Diagramme anzusprechen.
Option Explicit

Private Sub Worksheet_Activate()
    Dim objPivotItem As PivotItem
    Dim lngIndex As Long
    Application.ScreenUpdating = False
    EnableCalculation = False
    
With ChartObjects(1).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1") '---------------------- _
--Diagramm 1
        For Each objPivotItem In .PivotItems
            objPivotItem.Visible = True
        Next
        For Each objPivotItem In .PivotItems
            With objPivotItem
                .Visible = Val(.Value) = Cells(1, 13).Value
            End With
        Next
    End With
    With ChartObjects(1).Chart.PivotLayout.PivotTable.PivotFields("KW")
        For Each objPivotItem In .PivotItems
            objPivotItem.Visible = True
        Next
        For lngIndex = 1 To .PivotItems.Count - 9 '3 ist die Anzahl der angezeigten KW's !!!!!!! _
!!!!!
            .PivotItems.Item(lngIndex).Visible = False
        Next
    End With
    
    With ChartObjects(2).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1") '------------------ _
------Diagramm 2
        For Each objPivotItem In .PivotItems
            objPivotItem.Visible = True
        Next
        For Each objPivotItem In .PivotItems
            With objPivotItem
                .Visible = Val(.Value) = Cells(1, 13).Value
            End With
        Next
    End With
    With ChartObjects(2).Chart.PivotLayout.PivotTable.PivotFields("KW")
        For Each objPivotItem In .PivotItems
            objPivotItem.Visible = True
        Next
        For lngIndex = 1 To .PivotItems.Count - 5 '3 ist die Anzahl der angezeigten KW's !!!!!!! _
!!!!!
            .PivotItems.Item(lngIndex).Visible = False
        Next
    End With
    
    With ChartObjects(3).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1") '------------------ _
------Diagramm 3
        For Each objPivotItem In .PivotItems
            objPivotItem.Visible = True
        Next
        For Each objPivotItem In .PivotItems
            With objPivotItem
                .Visible = Val(.Value) = Cells(1, 13).Value
            End With
        Next
    End With
    With ChartObjects(3).Chart.PivotLayout.PivotTable.PivotFields("KW")
        For Each objPivotItem In .PivotItems
            objPivotItem.Visible = True
        Next
        For lngIndex = 1 To .PivotItems.Count - 5 '3 ist die Anzahl der angezeigten KW's !!!!!!! _
!!!!!
            .PivotItems.Item(lngIndex).Visible = False
        Next
    End With
    
   
    
    EnableCalculation = True
    Application.ScreenUpdating = True
End Sub
ich versteh einfach nicht ganz den code. woran sehe ich auf welche pivottabelle ich mich beziehe? das erste Diagramm funktioniert ChartObjects(1).Chart.....bezieht sich auf Tabelle 2
ChartObjects(2).Chart soll sich auf Tabelle 3 beziehen
ChartObjects(3).Chart auf Tabelle 4
wird daraus nicht schlau wo ich sehen kann welche Tabelle wirklich die 1,2 oder 3 ist.
mfg
christian

Bild

Betrifft: AW: Filter in diagrammen automatisieren
von: Nepumuk
Geschrieben am: 19.04.2015 00:26:06
Hallo,
wenn du das so machst, dann müssen entweder alle Diagramme in einer Tabelle sein, oder du gibst die Tabelle in der sie sich befinden mit an.
Gruß
Nepumuk

Bild

Betrifft: AW: Filter in diagrammen automatisieren
von: Nepumuk
Geschrieben am: 19.04.2015 10:40:15
Hallo,
den letzten Code hatte ich im falschen Thread gepostet. Der sah so aus:

Option Explicit

Private Sub Worksheet_Activate()
    Dim objPivotItem As PivotItem
    Dim lngIndex As Long
    Application.ScreenUpdating = False
    EnableCalculation = False
    With ChartObjects(1).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1")
        For Each objPivotItem In .PivotItems
            objPivotItem.Visible = True
        Next
        For Each objPivotItem In .PivotItems
            With objPivotItem
                .Visible = Val(.Value) = Cells(1, 13).Value
            End With
        Next
    End With
    With ChartObjects(1).Chart.PivotLayout.PivotTable.PivotFields("KW")
        For Each objPivotItem In .PivotItems
            objPivotItem.Visible = True
        Next
        For lngIndex = 1 To .PivotItems.Count - 3 '3 ist die Anzahl der angezeigten KW's !!!!!!!!!!!!
            .PivotItems.Item(lngIndex).Visible = False
        Next
    End With
    EnableCalculation = True
    Application.ScreenUpdating = True
End Sub

Die Idee war eigentlich, dass du in jeder Tabelle in der sich ein Diagramm befindet diesen einfügst. Dann könntest du auch direkt auf eine Änderung der Zahl in M1 reagieren.
Gruß
Nepumuk

Bild

Betrifft: AW: Filter in diagrammen automatisieren
von: Spenski
Geschrieben am: 19.04.2015 11:48:23
Guten Morgen Nepumuk

Die Idee war eigentlich, dass du in jeder Tabelle in der sich ein Diagramm befindet diesen einfügst. Dann könntest du auch direkt auf eine Änderung der Zahl in M1 reagieren.

ja genauso hab ich es auch vor. Mit einem Diagramm klappt es auch wunderbar. sheets 4-15 sollen alle die selben Diagramme haben und nur über den wert in M1 gefiltert werden.heisst das sie auch alle den selben code in ihre Arbeitsblätter bekommen.
was ich nur gerade versuche ist in jedem sheet 3 verschiedene Diagramme mit 3 unterschiedlichen datenquellen zu haben und diese genauso zu filtern. ich weiss aber nicht genau wie ich die Diagramme genau ansprechen soll...
Diagramme sind erstmal nur im tabellenblatt SF 2
http://www.file-upload.net/download-10551341/WPA_STOPS.xlsm.html
danke und schönen sonntag
christian

Bild

Betrifft: AW: Filter in diagrammen automatisieren
von: Nepumuk
Geschrieben am: 19.04.2015 12:23:06
Hallo,
da ist noch ein Fehler in der Tabelle. Wenn ich versuche im mittleren Diagramm manuell alle Ebenen einblenden will, dann bekomme ich eine Fehlermeldung bezüglich der Überlappung von Bereichen. Darum steigt mein Makro auch aus.
Gruß
Nepumuk

Bild

Betrifft: AW: Filter in diagrammen automatisieren
von: Spenski
Geschrieben am: 19.04.2015 12:53:52
Ja bei dem Fehler bin ich auch hängen geblieben....
das komische ist aber das bei allen 3 Diagrammen/Pivottabellen die gleiche datenquelle ist : Hilfstabelle!$A$1:$I$5000
beim oberen ist nur ebene 1
beim mittleren ebene 1+2
beim unteren ebene 1-3
beim unteren funktioniert der code aber komischer weise.... hab auch alles noch mal neu gemacht (Pivot u Chart) aber wieder das selbe Problem
gruß

Bild

Betrifft: Pivotspezialist gefrag
von: Nepumuk
Geschrieben am: 19.04.2015 12:58:55
Hallo,
ich hab selber noch nie mit Pivot gearbeitet, daher kann ich dir da nicht helfen. Ich stell die Frage mal auf offen.
Gruß
Nepumuk

Bild

Betrifft: AW: Filter in diagrammen automatisieren
von: Spenski
Geschrieben am: 19.04.2015 13:00:28
ok jetzt weiss ich was du meinst....hab zwischen den pivottabellen jetzt mehr zeilen und es funktioniert .... hätt ich selber drauf kommen müssen :(
läuft super... jetzt hab ich nur noch das Problem mit der Fehlermeldung wenn es keine Daten zu der zahl in M1 gibt (was durchaus vorkommen kann)
[url=http://www.fotos-hochladen.net][img]http://www.fotos-hochladen.net/uploads/unbenannth7q65sc1oz.jpg[/img][/url]
kann man das abfangen?

Bild

Betrifft: AW: Filter in diagrammen automatisieren
von: Nepumuk
Geschrieben am: 19.04.2015 13:03:27
Hallo,
dann teste mal:

Option Explicit

Private Sub Worksheet_Activate()
    
    Dim objPivotItem As PivotItem
    Dim lngIndex As Long
    Dim blnFound As Boolean
    
    Application.ScreenUpdating = False
    EnableCalculation = False
    
    For Each objPivotItem In ChartObjects(1).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1").PivotItems
        With objPivotItem
            .Visible = True
            If Val(.Value) = Cells(1, 13).Value Then blnFound = True
        End With
    Next
    If blnFound Then
        For Each objPivotItem In ChartObjects(1).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1").PivotItems
            With objPivotItem
                .Visible = Val(.Value) = Cells(1, 13).Value
            End With
        Next
        With ChartObjects(1).Chart.PivotLayout.PivotTable.PivotFields("KW")
            For Each objPivotItem In .PivotItems
                objPivotItem.Visible = True
            Next
            For lngIndex = 1 To .PivotItems.Count - 5
                .PivotItems.Item(lngIndex).Visible = False
            Next
        End With
    Else
        ChartObjects(1).Select
        MsgBox "Der Wert ist nicht in der Liste von Diagramm 1", vbExclamation, "Hinweis"
    End If
    
    blnFound = False
    For Each objPivotItem In ChartObjects(2).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1").PivotItems
        With objPivotItem
            .Visible = True
            If Val(.Value) = Cells(1, 13).Value Then blnFound = True
        End With
    Next
    If blnFound Then
        For Each objPivotItem In ChartObjects(2).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1").PivotItems
            With objPivotItem
                .Visible = Val(.Value) = Cells(1, 13).Value
            End With
        Next
        With ChartObjects(2).Chart.PivotLayout.PivotTable.PivotFields("KW")
            For Each objPivotItem In .PivotItems
                objPivotItem.Visible = True
            Next
            For lngIndex = 1 To .PivotItems.Count - 5
                .PivotItems.Item(lngIndex).Visible = False
            Next
        End With
    Else
        ChartObjects (2)
        MsgBox "Der Wert ist nicht in der Liste von Diagramm 2", vbExclamation, "Hinweis"
    End If
    
    blnFound = False
    For Each objPivotItem In ChartObjects(3).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1").PivotItems
        With objPivotItem
            .Visible = True
            If Val(.Value) = Cells(1, 13).Value Then blnFound = True
        End With
    Next
    If blnFound Then
        For Each objPivotItem In ChartObjects(3).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1").PivotItems
            With objPivotItem
                .Visible = Val(.Value) = Cells(1, 13).Value
            End With
        Next
        With ChartObjects(3).Chart.PivotLayout.PivotTable.PivotFields("KW")
            For Each objPivotItem In .PivotItems
                objPivotItem.Visible = True
            Next
            For lngIndex = 1 To .PivotItems.Count - 5
                .PivotItems.Item(lngIndex).Visible = False
            Next
        End With
    Else
        ChartObjects (3)
        MsgBox "Der Wert ist nicht in der Liste von Diagramm 3", vbExclamation, "Hinweis"
    End If
    
    EnableCalculation = True
    Application.ScreenUpdating = True
End Sub

Gruß
Nepumuk

Bild

Betrifft: AW: Filter in diagrammen automatisieren
von: Spenski
Geschrieben am: 19.04.2015 13:24:01
Klappt super .. hab es bisschen abgeändert. wenn im ersten Diagramm nix gefunden wird, wird in den anderen 3 auch nix gefunden. hab also nach der ersten msgbox ein Exit Sub eingebaut und den unteren teil durch den alten code ersetzt:
da ist mir aufgefallen das wenn er nix findet ja trotzdem ´den filter rausnimmt und ich dann alle Daten in dem Diagramm habe...
gibt es noch die Möglichkeit wenn er nix findet bei allen Diagrammen die filter rauszunehmen?? also das alle 3 Diagramme leer sind...
und noch ne kleine frage...er rechnet jetzt natürlich lange bis er die 3 Pivot durchfiltert...das aber normal oder?
gruss
Christian
Option Explicit

Private Sub Worksheet_Activate()
    
    Dim objPivotItem As PivotItem
    Dim lngIndex As Long
    Dim blnFound As Boolean
    
    Application.ScreenUpdating = False
    EnableCalculation = False
    
    For Each objPivotItem In ChartObjects(1).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1") _
.PivotItems
        With objPivotItem
            .Visible = True
            If Val(.Value) = Cells(1, 13).Value Then blnFound = True
        End With
    Next
    If blnFound Then
        For Each objPivotItem In ChartObjects(1).Chart.PivotLayout.PivotTable.PivotFields(" _
Ebene 1").PivotItems
            With objPivotItem
                .Visible = Val(.Value) = Cells(1, 13).Value
            End With
        Next
        With ChartObjects(1).Chart.PivotLayout.PivotTable.PivotFields("KW")
            For Each objPivotItem In .PivotItems
                objPivotItem.Visible = True
            Next
            For lngIndex = 1 To .PivotItems.Count - 10
                .PivotItems.Item(lngIndex).Visible = False
            Next
        End With
    Else
        ChartObjects(1).Select
        MsgBox "Der Wert ist nicht in der Liste von Diagramm 1", vbExclamation, "Hinweis"
        Exit Sub
    End If
    
    
    With ChartObjects(2).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1")
        For Each objPivotItem In .PivotItems
            objPivotItem.Visible = True
        Next
        For Each objPivotItem In .PivotItems
            With objPivotItem
                .Visible = Val(.Value) = Cells(1, 13).Value
            End With
        Next
    End With
    With ChartObjects(2).Chart.PivotLayout.PivotTable.PivotFields("KW")
        For Each objPivotItem In .PivotItems
            objPivotItem.Visible = True
        Next
        For lngIndex = 1 To .PivotItems.Count - 6 'ist die Anzahl der angezeigten KW's !!!!!!!!! _
!!!
            .PivotItems.Item(lngIndex).Visible = False
        Next
    End With
    
    With ChartObjects(3).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1")
        For Each objPivotItem In .PivotItems
            objPivotItem.Visible = True
        Next
        For Each objPivotItem In .PivotItems
            With objPivotItem
                .Visible = Val(.Value) = Cells(1, 13).Value
            End With
        Next
    End With
    With ChartObjects(3).Chart.PivotLayout.PivotTable.PivotFields("KW")
        For Each objPivotItem In .PivotItems
            objPivotItem.Visible = True
        Next
        For lngIndex = 1 To .PivotItems.Count - 6 'ist die Anzahl der angezeigten KW's !!!!!!!!! _
!!!
            .PivotItems.Item(lngIndex).Visible = False
        Next
    End With
    
    EnableCalculation = True
    Application.ScreenUpdating = True
End Sub


Bild

Betrifft: AW: Filter in diagrammen automatisieren
von: Nepumuk
Geschrieben am: 19.04.2015 13:35:41
Hallo,
so finde ich es eleganter:

Option Explicit

Private Sub Worksheet_Activate()
    
    Dim objPivotItem As PivotItem
    Dim lngIndex As Long
    Dim blnFound As Boolean
    
    Application.ScreenUpdating = False
    EnableCalculation = False
    
    For Each objPivotItem In ChartObjects(1).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1").PivotItems
        With objPivotItem
            .Visible = True
            If Val(.Value) = Cells(1, 13).Value Then blnFound = True
        End With
    Next
    If blnFound Then
        For Each objPivotItem In ChartObjects(1).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1").PivotItems
            With objPivotItem
                .Visible = Val(.Value) = Cells(1, 13).Value
            End With
        Next
        With ChartObjects(1).Chart.PivotLayout.PivotTable.PivotFields("KW")
            For Each objPivotItem In .PivotItems
                objPivotItem.Visible = True
            Next
            For lngIndex = 1 To .PivotItems.Count - 10
                .PivotItems.Item(lngIndex).Visible = False
            Next
        End With
    Else
        MsgBox "Der Wert ist nicht in der Liste.", vbExclamation, "Hinweis"
    End If
    
    
    For Each objPivotItem In ChartObjects(2).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1").PivotItems
        objPivotItem.Visible = True
    Next
    If blnFound Then
        For Each objPivotItem In ChartObjects(2).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1").PivotItems
            With objPivotItem
                .Visible = Val(.Value) = Cells(1, 13).Value
            End With
        Next
        With ChartObjects(2).Chart.PivotLayout.PivotTable.PivotFields("KW")
            For Each objPivotItem In .PivotItems
                objPivotItem.Visible = True
            Next
            For lngIndex = 1 To .PivotItems.Count - 6
                .PivotItems.Item(lngIndex).Visible = False
            Next
        End With
    End If
    
    For Each objPivotItem In ChartObjects(3).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1").PivotItems
        objPivotItem.Visible = True
    Next
    If blnFound Then
        For Each objPivotItem In ChartObjects(3).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1").PivotItems
            With objPivotItem
                .Visible = Val(.Value) = Cells(1, 13).Value
            End With
        Next
        With ChartObjects(3).Chart.PivotLayout.PivotTable.PivotFields("KW")
            For Each objPivotItem In .PivotItems
                objPivotItem.Visible = True
            Next
            For lngIndex = 1 To .PivotItems.Count - 6
                .PivotItems.Item(lngIndex).Visible = False
            Next
        End With
    End If
    
    EnableCalculation = True
    Application.ScreenUpdating = True
End Sub

Und nein, an der Geschwindigkeit kann ich nichts machen.
Gruß
Nepumuk

Bild

Betrifft: AW: Filter in diagrammen automatisieren
von: Spenski
Geschrieben am: 19.04.2015 13:49:20
okay
ja mit der Geschwindigkeit hab ich mir gedacht, aber ist ja auch verständlich bei den ablauf den er macht, sind immerhin 3 Tabellen die gefiltert werden.
und das die Diagramme leer sind wenn er nix findet? geht das?
gruß

Bild

Betrifft: AW: Filter in diagrammen automatisieren
von: Nepumuk
Geschrieben am: 19.04.2015 13:58:53
Hallo,
teste mal:

Option Explicit

Private Sub Worksheet_Activate()
    
    Dim objPivotItem As PivotItem
    Dim lngIndex As Long
    Dim blnFound As Boolean
    
    Application.ScreenUpdating = False
    EnableCalculation = False
    
    For Each objPivotItem In ChartObjects(1).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1").PivotItems
        With objPivotItem
            .Visible = True
            If Val(.Value) = Cells(1, 13).Value Then blnFound = True
        End With
    Next
    If blnFound Then
        For Each objPivotItem In ChartObjects(1).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1").PivotItems
            With objPivotItem
                .Visible = Val(.Value) = Cells(1, 13).Value
            End With
        Next
        With ChartObjects(1).Chart.PivotLayout.PivotTable.PivotFields("KW")
            For Each objPivotItem In .PivotItems
                objPivotItem.Visible = True
            Next
            For lngIndex = 1 To .PivotItems.Count - 10
                .PivotItems.Item(lngIndex).Visible = False
            Next
        End With
    Else
        MsgBox "Der Wert ist nicht in der Liste.", vbExclamation, "Hinweis"
        For Each objPivotItem In ChartObjects(1).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1").PivotItems
            objPivotItem.Visible = False
        Next
    End If
    
    If blnFound Then
        For Each objPivotItem In ChartObjects(2).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1").PivotItems
            objPivotItem.Visible = True
        Next
        For Each objPivotItem In ChartObjects(2).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1").PivotItems
            With objPivotItem
                .Visible = Val(.Value) = Cells(1, 13).Value
            End With
        Next
        With ChartObjects(2).Chart.PivotLayout.PivotTable.PivotFields("KW")
            For Each objPivotItem In .PivotItems
                objPivotItem.Visible = True
            Next
            For lngIndex = 1 To .PivotItems.Count - 6
                .PivotItems.Item(lngIndex).Visible = False
            Next
        End With
    Else
        For Each objPivotItem In ChartObjects(2).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1").PivotItems
            objPivotItem.Visible = False
        Next
    End If
    
    If blnFound Then
        For Each objPivotItem In ChartObjects(3).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1").PivotItems
            objPivotItem.Visible = True
        Next
        For Each objPivotItem In ChartObjects(3).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1").PivotItems
            With objPivotItem
                .Visible = Val(.Value) = Cells(1, 13).Value
            End With
        Next
        With ChartObjects(3).Chart.PivotLayout.PivotTable.PivotFields("KW")
            For Each objPivotItem In .PivotItems
                objPivotItem.Visible = True
            Next
            For lngIndex = 1 To .PivotItems.Count - 6
                .PivotItems.Item(lngIndex).Visible = False
            Next
        End With
    Else
        For Each objPivotItem In ChartObjects(3).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1").PivotItems
            objPivotItem.Visible = False
        Next
    End If
    
    EnableCalculation = True
    Application.ScreenUpdating = True
End Sub

Gruß
Nepumuk

Bild

Betrifft: AW: Filter in diagrammen automatisieren
von: Spenski
Geschrieben am: 19.04.2015 14:06:01
da spuckt er mir hier n fehler aus :
Else
MsgBox "Der Wert ist nicht in der Liste.", vbExclamation, "Hinweis"
For Each objPivotItem In ChartObjects(1).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1").PivotItems
objPivotItem.Visible = False
Next
End If
ich habs jetzt so und es funktioniert, vielleicht nicht optimal aber es läuft:
Option Explicit

Private Sub Worksheet_Activate()
    
    ActiveSheet.ChartObjects(1).Visible = True
    ActiveSheet.ChartObjects(2).Visible = True
    ActiveSheet.ChartObjects(3).Visible = True
    
    
    Dim objPivotItem As PivotItem
    Dim lngIndex As Long
    Dim blnFound As Boolean
    
    Application.ScreenUpdating = False
    EnableCalculation = False
    
    For Each objPivotItem In ChartObjects(1).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1") _
.PivotItems
        With objPivotItem
            .Visible = True
            If Val(.Value) = Cells(1, 13).Value Then blnFound = True
        End With
    Next
    If blnFound Then
        For Each objPivotItem In ChartObjects(1).Chart.PivotLayout.PivotTable.PivotFields(" _
Ebene 1").PivotItems
            With objPivotItem
                .Visible = Val(.Value) = Cells(1, 13).Value
            End With
        Next
        With ChartObjects(1).Chart.PivotLayout.PivotTable.PivotFields("KW")
            For Each objPivotItem In .PivotItems
                objPivotItem.Visible = True
            Next
            For lngIndex = 1 To .PivotItems.Count - 10
                .PivotItems.Item(lngIndex).Visible = False
            Next
        End With
    Else
    ActiveSheet.ChartObjects(1).Visible = False
    ActiveSheet.ChartObjects(2).Visible = False
    ActiveSheet.ChartObjects(3).Visible = False
    End If
    
    
    For Each objPivotItem In ChartObjects(2).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1") _
.PivotItems
        objPivotItem.Visible = True
    Next
    If blnFound Then
        For Each objPivotItem In ChartObjects(2).Chart.PivotLayout.PivotTable.PivotFields(" _
Ebene 1").PivotItems
            With objPivotItem
                .Visible = Val(.Value) = Cells(1, 13).Value
            End With
        Next
        With ChartObjects(2).Chart.PivotLayout.PivotTable.PivotFields("KW")
            For Each objPivotItem In .PivotItems
                objPivotItem.Visible = True
            Next
            For lngIndex = 1 To .PivotItems.Count - 6
                .PivotItems.Item(lngIndex).Visible = False
            Next
        End With
    End If
    
    For Each objPivotItem In ChartObjects(3).Chart.PivotLayout.PivotTable.PivotFields("Ebene 1") _
.PivotItems
        objPivotItem.Visible = True
    Next
    If blnFound Then
        For Each objPivotItem In ChartObjects(3).Chart.PivotLayout.PivotTable.PivotFields(" _
Ebene 1").PivotItems
            With objPivotItem
                .Visible = Val(.Value) = Cells(1, 13).Value
            End With
        Next
        With ChartObjects(3).Chart.PivotLayout.PivotTable.PivotFields("KW")
            For Each objPivotItem In .PivotItems
                objPivotItem.Visible = True
            Next
            For lngIndex = 1 To .PivotItems.Count - 6
                .PivotItems.Item(lngIndex).Visible = False
            Next
        End With
    End If
    
    EnableCalculation = True
    Application.ScreenUpdating = True
End Sub

DANKE DANKE DANKE für deine hilfe
gruß
Christian

Bild

Betrifft: AW: Filter in diagrammen automatisieren
von: Spenski
Geschrieben am: 19.04.2015 20:05:31
habs jetzt nochmal anders aufgebaut da mich 45-60 sec Ladezeit doch bisschen abgeschreckt haben.
hab durch zufall den Datenschnitt bei Diagrammen entdeckt und das ist perfekt.
hab dein code dann nur für die Kalenderwochen genutzt und nun ist es schnell und einfach zu bedienen :D
falls es interessiert.
http://www.file-upload.net/download-10552606/WPA_STOPS3.xlsm.html
und nochmal danke für deinen hohen Zeitaufwand
gruss und einen schönen start in die Woche
christian

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Filter in diagrammen automatisieren"