AW: VBA Pivot erweitern, reduzieren per Butt
23.03.2021 00:18:49
fcs
Hallo Marc,
ich habe noch etwas getüftelt und eine Lösung gefunden.
Die Lösung ist aber sehr speziell für die jeweiligen Pivot-Tabellen. Falls du damit nicht zurechtkommst, dann lade bitte eine Beispieldatei hoch. Eine Beispieltabelle hilft fast immer bei einer Lösung.
Sub Diagramm_reduzieren()
Dim intStatus As Integer
With Worksheets("Pivot Board")
intStatus = fncStatusEnde_Jahr(.PivotTables("PivotTable8").PivotFields("Ende Jahr")) _
+ fncStatusQuartale(.PivotTables("PivotTable8").PivotFields("Quartale")) * 10
Select Case intStatus
Case 11 'Quartale und Monate sind eingeblendet
.PivotTables("PivotTable8").PivotFields("Quartale").ShowDetail = False
.PivotTables("PivotTable9").PivotFields("Quartale").ShowDetail = False
Case 21 'nur Quartale sind eingeblendet
.PivotTables("PivotTable8").PivotFields("Ende Jahr").ShowDetail = False
.PivotTables("PivotTable9").PivotFields("Ende Jahr").ShowDetail = False
Case 2 'Quartale und Monate sind ausgeblendet
Case Else
End Select
End With
End Sub
Sub Diagramm_erweitern()
Dim intStatus As Integer
With Worksheets("Pivot Board")
intStatus = fncStatusEnde_Jahr(.PivotTables("PivotTable8").PivotFields("Ende Jahr")) _
+ fncStatusQuartale(.PivotTables("PivotTable8").PivotFields("Quartale")) * 10
Select Case intStatus
Case 11 'Quartale und Monate sind eingeblendet
Case 21 'nur Quartale sind eingeblendet
.PivotTables("PivotTable8").PivotFields("Quartale").ShowDetail = True
.PivotTables("PivotTable9").PivotFields("Quartale").ShowDetail = True
Case 2 'Quartale und Monate sind ausgeblendet
.PivotTables("PivotTable8").PivotFields("Ende Jahr").ShowDetail = True
.PivotTables("PivotTable9").PivotFields("Ende Jahr").ShowDetail = True
Case Else
End Select
End With
End Sub
Function fncStatusQuartale(pvField As PivotField) As Integer
Dim bolStatus As Boolean
Dim strItem As String
Dim rngZelle As Range
strItem = "Qrtl"
bolStatus = False
For Each rngZelle In pvField.DataRange.Cells
If Left(rngZelle.Text, 4) = strItem Then
bolStatus = rngZelle.ShowDetail
If bolStatus = True Then
fncStatusQuartale = 1 'Monate werden angezeigt
Else
fncStatusQuartale = 2 'Monate sind ausgeblendet
End If
Exit For
End If
Next
End Function
Function fncStatusEnde_Jahr(pvField As PivotField) As Integer
Dim bolStatus As Boolean
Dim strItem As String
Dim rngZelle As Range
strItem = pvField.PivotItems(1).Name
If Not IsNumeric(Left(strItem, 1)) Then
strItem = Mid(pvField.PivotItems(1).Name, 2)
End If
strItem = CDate(strItem)
strItem = Right(strItem, 4)
For Each rngZelle In pvField.DataRange.Cells
If rngZelle.Text = strItem Then
bolStatus = rngZelle.ShowDetail
If bolStatus = True Then
fncStatusEnde_Jahr = 1 'Quartale werden angezeigt
Else
fncStatusEnde_Jahr = 2 'Quartale sind ausgeblendet
End If
Exit For
End If
Next
End Function
LG
Franz