unregelmäßige Fehlermeldung VBA und teilweise falsche Datenwahl bei Pivot

[holg620]

Hallo zusammen,

dies ist eine Fortsetzung des Threads http://www.clever-excel-forum.de/thread-...age-2.html
da es hier nun um ein anderes Thema geht.

An sich funktioniert es, aber es kommen "Bugs" vor.

Und zwar tritt folgendes Problem auf:

1) Die PT nimmt bei manchen Codes aus unerklärlichen Gründen eine falsche Datenauswahl. Dies ist zu erkennen, wenn die Gesamtstundenzahl nicht mit den gebuchten Stunden aus der SummeWenn Formel oben übereinstimmt.
Bei großen Projekten mag das am Top5 Filter liegen, dass die Stundenzahl nicht übereinstimmt, da die kleinen Summen wegfallen. Aber es tritt auch bei weniger Mitarbeitern auf.
Bei Projekt 4732 wird zB. Projekt 4066 als Datenbasis gewählt.

2) Unregelmäßig tritt ein Fehler beim Makro auf. Manchmal schnell, manchmal erst nach mehrmaligen wechseln des Codes. Dann steht dort:

Laufzeitfehler 1004:
Anwendungs- oder objektdefinierter Fehler.

Diese Zeile wird markiert:
.PivotFields("ProjectCode").CurrentPage = Sheets("Hintergrund").[B19].Value

Hier der VBA Code
Modul1

Sub PivAendern()
With Sheets("Projekt-Status").PivotTables(1)
If Sheets("Projekt-Status").[E15] <> "KEINE BUCHUNG" Then
.PivotFields("ProjectCode").CurrentPage = Sheets("Hintergrund").[B19].Value
.PivotCache.Refresh
End If
If Sheets("Projekt-Status").[E15] = "KEINE BUCHUNG" Then
.PivotFields("ProjectCode").CurrentPage = "(Alle)"
.PivotCache.Refresh
End If
End With
End Sub

Klasse1

Private Sub Worksheet_Change(ByVal Target As Range)
Call PivAendern
End Sub

Eine anonymisierte Beispieltabelle befindet sich im Anhang. In der Orginaltabelle gibt es weitaus mehr Tabellen, auch andere Pivots, aber daran scheint es nicht zu liegen, da der Fehler auch in der Beispielmappe auftaucht.
Außerdem musste ich Positionen 1-4003 herauslöschen, damit die Tabelle unter 1 MB bleibt.

[atilla]

Hallo,

erst einmal würde ich das Anstoßen der Filterung nicht mit dem Ereignis Worksheet_SelectionChange sondern mit dem Ereignis Worksheet_Change erledigen

So:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Address(0, 0) = C4 Then
      Application.EnableEvents = False
      Call PivAendern
      Application.EnableEvents = True
End Sub

Dann lies mal hier Beschränkungen von PivotTables in Excel

Da steht unter anderem:

Maximale Anzahl von Elementen pro Pivot-Feld
Es besteht eine Beschränkung auf 8.000 eindeutige Elemente pro Zeilen-, Spalten- oder Seitenfeld. Wenn Sie versuchen, ein Feld in der PivotTable abzulegen, das diese Beschränkung überschreitet, wird das Feld nicht zur PivotTable hinzugefügt. Außerdem wird möglicherweise die folgende Warnmeldung angezeigt:

Und Du hast 8396 unterschiedliche Einträge.
Und der Projekt 4732 hat den Code 1038495376 fällt dann wahrscheinlich raus, da er nach 8000 Zeilen auftaucht.

[holg620]

Hallo atilla, danke für den Hinweis.

Das erklärt die Dysfunktionalität natürlich. Was ist genau mit Einträgen gemeint?
Die Frage ist, wie ich das ganze nun umsetzen kann :/

[atilla]

Hallo,

Was ist genau mit Einträgen gemeint?

Die Einträge in der Spalte B in der Tabelle Kostenerfassung.

Die Frage ist, wie ich das ganze nun umsetzen kann :/

Das ginge per VBA. Da müsste man dann das Arbeiten mit Feldern und Arrays beherrschen, damit es performant bleibt.

Hier gibt es eine Einführung: Felder - Arrays (1) - Einführung

[holg620]

Hallo atilla,

fehlt in deinem Code noch ein End if?

Ich habe es so übernommen mit einen End If, doch greift es irgendwie nicht.

[atilla]

Hallo,

ja, in der Tat, es fehlt das End if:

so muss es richtig sein:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Address(0, 0) = C4 Then
      Application.EnableEvents = False
      Call PivAendern
      Application.EnableEvents = True
   End if
End Sub

Der Code reagiert auf Zelländerung der Zelle C4.
Zum Testen, einfach mal in die Zelle doppelklicken und mit Enter verlassen.

Wenn nichts passiert, dann kann es sein, dass es nach Ausführung der ZeileApplication.EnableEvents = False zum Fehler gekommen ist und die Ausführung abgebrochen wurde. In dem Fall einfach Datei schliessen und wieder öffnen oder in der VBA Umgebung im Direktfenster Application.EnableEvents = True eingeben und mit Enter bestätigen.