Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1420to1424
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
Inhaltsverzeichnis

Filter in diagrammen automatisieren

Filter in diagrammen automatisieren
18.04.2015 17:20:08
Spenski
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

21
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Filter in diagrammen automatisieren
18.04.2015 17:40:54
Nepumuk
Hallo,
klar. Als Beispiel genügt eine kleine Tabelle und 2 Diagramme.
Gruß
Nepumuk

AW: Filter in diagrammen automatisieren
18.04.2015 17:51:32
Spenski
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

AW: Filter in diagrammen automatisieren
18.04.2015 18:24:58
Nepumuk
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

Anzeige
AW: Filter in diagrammen automatisieren
18.04.2015 18:53:22
Spenski
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

AW: Filter in diagrammen automatisieren
18.04.2015 20:58:33
Spenski
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

Anzeige
AW: Filter in diagrammen automatisieren
18.04.2015 21:12:14
Nepumuk
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

AW: Filter in diagrammen automatisieren
18.04.2015 23:52:25
Spenski
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

Anzeige
AW: Filter in diagrammen automatisieren
19.04.2015 00:26:06
Nepumuk
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

AW: Filter in diagrammen automatisieren
19.04.2015 10:40:15
Nepumuk
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

Anzeige
AW: Filter in diagrammen automatisieren
19.04.2015 11:48:23
Spenski
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

Anzeige
AW: Filter in diagrammen automatisieren
19.04.2015 12:23:06
Nepumuk
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

AW: Filter in diagrammen automatisieren
19.04.2015 12:53:52
Spenski
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ß

Anzeige
Pivotspezialist gefrag
19.04.2015 12:58:55
Nepumuk
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

AW: Filter in diagrammen automatisieren
19.04.2015 13:00:28
Spenski
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?

Anzeige
AW: Filter in diagrammen automatisieren
19.04.2015 13:03:27
Nepumuk
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

Anzeige
AW: Filter in diagrammen automatisieren
19.04.2015 13:24:01
Spenski
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

Anzeige
AW: Filter in diagrammen automatisieren
19.04.2015 13:35:41
Nepumuk
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

AW: Filter in diagrammen automatisieren
19.04.2015 13:49:20
Spenski
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ß

AW: Filter in diagrammen automatisieren
19.04.2015 13:58:53
Nepumuk
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

AW: Filter in diagrammen automatisieren
19.04.2015 14:06:01
Spenski
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

AW: Filter in diagrammen automatisieren
19.04.2015 20:05:31
Spenski
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

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige