PivotTabellen und VBA... | Herbers Excel-Forum

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

Informationen und Beispiele zum Thema MsgBox
Screenshot zu MsgBox	MsgBox-Seite mit Beispielarbeitsmappe aufrufen

PivotTabellen und VBA... | Herbers Excel-Forum

PivotTabellen und VBA... von Jonathan vom 18.01.2010 11:57:09

AW: PivotTabellen und VBA... - von Jonathan am 18.01.2010 15:17:17
- AW: PivotTabellen und VBA... - von fcs am 19.01.2010 08:49:11
  - AW: PivotTabellen und VBA... - von Jonathan am 19.01.2010 11:18:38
    - AW: PivotTabellen und VBA... - von fcs am 19.01.2010 16:43:28
      - AW: PivotTabellen und VBA... - von Jonathan am 20.01.2010 15:13:52
        
        AW: PivotTabellen und VBA... - von fcs am 21.01.2010 08:00:16
      - AW: PivotTabellen und VBA... - von Jonathan am 20.01.2010 17:27:10

Betrifft: PivotTabellen und VBA... von: Jonathan
Geschrieben am: 18.01.2010 11:57:09

Hallo zusammen!

Ich möchte gerne ein paar Funktionen meiner PivotTabelle per VBA vereinfachen. Dazu habe ich folgenden Code geschrieben, welcher
1. prüft, ob der Wert der ausgewählten Zelle auch in der Liste der möglichen Kategorien vorkommt; ist dies der Fall:
2. ausblenden aller Kategorien, außer der ausgewählten und
3. zeigen der Details der ausgewählten Kategorie

Die Prozedur läuft allerdings super langsam ab - ich weiß nicht warum.
Kennt Ihr eine Möglichkeit, bei der Aufhebung des Filters direkt auch alle Details auszublenden?

Hier nun der Code:

Dim VertSort As Boolean

Sub VertclearFilters()
    ActiveSheet.PivotTables("PivVerteilung").PivotFields("Oberkategorie").ClearAllFilters
End Sub

Sub VertFilter()

With ActiveWorkbook.Worksheets("Ursprungsdaten")
  lngLast = Sheets("Ursprungsdaten").Cells(Rows.Count, 4).End(xlUp).Row
End With

VertSort = False
Wert = Sheets("Verteilung").Cells(ActiveCell.Row, ActiveCell.Column).Value

    If ActiveCell.Column = 1 Then
        For i = 2 To lngLast
            If Sheets("Verteilung").Cells(ActiveCell.Row, ActiveCell.Column).Value = Sheets(" _
Ursprungsdaten").Cells(i, 4).Value Then
                VertSort = True
            End If
        Next
    End If
    
    If VertSort = True Then
        ActiveSheet.PivotTables("PivVerteilung").PivotFields("Oberkategorie").ClearAllFilters
            With Sheets("Verteilung").PivotTables("PivVerteilung").PivotFields("Oberkategorie")
                For i = 2 To lngLast
                    If Sheets("Ursprungsdaten").Cells(i, 4).Value <> Wert Then
                        .PivotItems(Sheets("Ursprungsdaten").Cells(i, 4).Value).Visible = False
                    End If
                Next
                .PivotItems(Wert).ShowDetail = True
            End With
    End If
    
End Sub

Betrifft: AW: PivotTabellen und VBA... von: Jonathan
Geschrieben am: 18.01.2010 15:17:17

Hey,

mir ist gerade aufgefallen, dass ein Fehler auftritt, sobald im Sheet "Ursprungsdaten" ein Wert steht, welcher in der PivotTabelle nicht vorhanden ist.

Der Code funktioniert so also leider nicht....

Hoffe, mir kann jemand helfen?!

LG

Betrifft: AW: PivotTabellen und VBA... von: fcs
Geschrieben am: 19.01.2010 08:49:11

Hallo Jonathan,

folgendes Makro sollte es tun.

Gruß
Franz

Sub VertFilter()
  Dim wksPivot As Worksheet
  Dim pvTab As PivotTable, pvField As PivotField, pvItem As PivotItem
  Dim sItemName As String
  Dim Wert As Variant
  On Error GoTo fehler
  If ActiveCell.Column = 1 Then
    Application.screenuodating = False
    Wert = ActiveCell.Value
    Set wksPivot = ActiveWorkbook.Worksheets("Verteilung")
    Set pvTab = wksPivot.PivotTables("PivVerteilung")
    Set pvField = pvTab.PivotFields("Oberkategorie")
    sItemName = IIf(IsNumeric(Wert), CStr(Wert), Wert)
    With pvField
      For Each pvItem In .VisibleItems
          If pvItem.Name <> sItemName Then
            pvItem.Visible = False
          End If
      Next
      .PivotItems(sItemName).ShowDetail = True
    End With
  End If
  Err.Clear
fehler
  With Err
    Select Case .Number
      Case 0 ' alles OK
      Case Else
        MsgBox "Fehler-Nr. " & .Number & vbLf & .Description
    End Select
  Set wksPivot = Nothing
  Set pvTab = Nothing: Set pvField = Nothing: Set pvItem = Nothing
  Application.screenuodating = True
End Sub

Betrifft: AW: PivotTabellen und VBA... von: Jonathan
Geschrieben am: 19.01.2010 11:18:38

Hallo Franz!

Vielen Dank, das funktioniert! Das hätt ich nicht hinbekommen!

Zwei Fragen hab ich aber noch zu deinem Code:
Die Fehlerroutine funktioniert nicht, "fehler": Sub oder Funktion nicht definiert

Zum Löschen des Filters aus der Oberkategorie (ein Wert soll nicht angezeigt werden, habe ich folgendes probiert:

...
    With pvField
      For Each pvItem In pvField
          If pvItem.Name <> "Forderungen" Then
            pvItem.Visible = True
            pvItem.ShowDetail = False
          End If
      Next
    End With
...

Leider klappt das pvItem In pvField nicht. Hast du da noch einen Tipp?

Danke nochmal!!

LG

Betrifft: AW: PivotTabellen und VBA... von: fcs
Geschrieben am: 19.01.2010 16:43:28

Hallo Jonathan,

ungetestet und ins Blaue:

'entweder:

    With pvField
      For Each pvItem In .VisibleItems
          If pvItem.Name = "Forderungen" Then
            pvItem.ShowDetail = False
            pvItem.Visible = False
          End If
      Next
    End With

'oder:

    With pvField
      With .PivotItems("Forderungen")
        .ShowDetail = False
        .Visible = False
       End With
    End With

Gruß
Franz

Betrifft: AW: PivotTabellen und VBA... von: Jonathan
Geschrieben am: 20.01.2010 15:13:52

Hey,

ich möchte mit dem Code ja alle Items wieder einblenden - bis auf "Forderungen".

Habe es jetzt so getestet, aber das ist suuuuper langsam!


    With pvField
      For Each pvItem In .HiddenItems
          If pvItem.Name = "Forderungen" Then
            pvItem.ShowDetail = False
            pvItem.Visible = False
        Else
            pvItem.Visible = True
            pvItem.ShowDetail = False
          End If
      Next
    End With

Hast du da noch eine Idee, warum das so langsam abläuft?

Danke nochmal!!

Betrifft: AW: PivotTabellen und VBA... von: fcs
Geschrieben am: 21.01.2010 08:00:16

Hallo Jonathan,

wenn du Pivots elementweise abarbeitest, dann wird nach jeder Änderung eine komplette Neuberechnung der Tabelle durchgeführt und das kann dauern.

In deinem Fall sollte folgendes ruckzuck ablaufen:

    With pvField
      .ClearAllFilters
      .ShowDetail = False
      .PivotItems("Forderungen").Visible = False
    End With

' oder falls evtl das Item "Forderungen" nicht existiert
    With pvField
      .ClearAllFilters
      .ShowDetail = False
      For Each pvItem In .VisibleItems
          If pvItem.Name = "Forderungen" Then
            pvItem.ShowDetail = False
          End If
      Next
    End With

Gruß
Franz

Betrifft: AW: PivotTabellen und VBA... von: Jonathan
Geschrieben am: 20.01.2010 17:27:10

Hallo Franz!

Hab es jetzt ganz einfach gelöst:

Sub VertclearFilters()
    Application.ScreenUpdating = False

With ActiveSheet.PivotTables("PivVerteilung").PivotFields("Oberkategorie")
    .ClearAllFilters
    .ShowDetail = False
    .PivotItems("Forderungen").Visible = False
End With

    Application.ScreenUpdating = True
End Sub

Danke nochmal für deine Hilfe!

LG

Herbers Excel/VBA-Archiv

Der kurze Weg zum Ziel: Auftragsprogrammierung

PivotTabellen und VBA... | Herbers Excel-Forum