AW: Pivot-Tabelle über Textbox filtern
19.12.2020 22:14:12
Yal
Hallo Peter,
Menno! fcs hat gepostet, während ich meine Version debuggen musste.
Ich poste trotzdem:
Ich so ergänzt, dass
_ eine Zeichenfolge allein als "*(zeichenfolge)*" interpretiert wird
_ "*xxx*" ebenso
_ "xxx*" --> fängt mit xxx
_ "*xxx" --> endet mit xxx
_ ist die Zeichenfolge nicht vorhanden, wird "alles" gezeigt
Die Anzeige in Finally ist nur Debugging. nicht vergessen rauszumachen.
Gute Test-Kandidat: br, br*, bre, bre*, rg, erg, urg, *rg, *erg, *urg
Viel Erfolg damit
Yal
Dim PF As PivotField
Private Sub TextBox1_Change()
Dim PI As PivotItem
Dim CompText As String
Dim CompTyp As String
' Debug: Anzeige leeren
On Error Resume Next:
' Ende Debug
On Error GoTo Catch
Try:
Application.EnableEvents = False
Application.ScreenUpdating = False
Set PF = ActiveSheet.PivotTables("PivotTable1").PivotFields("Stadt")
CompText = LCase(Trim([B3]))
PF.ClearAllFilters
If CompText = "" Or CompText = "*" Then
Alle_setzen
Else
PF.EnableMultiplePageItems = True
If Left(CompText, 1) = "*" Then CompTyp = "EndeVergleich"
If Right(CompText, 1) = "*" Then CompTyp = CompTyp & "AnfangVergleich"
CompText = Replace(CompText, "*", "")
Select Case CompTyp
Case "EndeVergleich"
For Each PI In PF.PivotItems: PI.Visible = (LCase(Right(PI.Caption, Len(CompText))) = _
CompText): Next
Case "AnfangVergleich"
For Each PI In PF.PivotItems: PI.Visible = (LCase(Left(PI.Caption, Len(CompText))) = _
CompText): Next
Case Else
For Each PI In PF.PivotItems: PI.Visible = (InStr(1, PI.Caption, CompText, _
vbTextCompare) > 0): Next
End Select
End If
GoTo Finally
Catch:
Select Case Err.Number
Case 1004: Alle_setzen
Case Else: Debug.Print Err.Number, Err.Description
End Select
Finally:
' Debug: Anzeige der Treffer
Anzeigen
' Ende Debug
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Private Sub Alle_setzen()
PF.ClearAllFilters
PF.EnableMultiplePageItems = False
PF.CurrentPage = "(All)"
End Sub
Sub Anzeigen()
Dim PI As PivotItem
On Error Resume Next
Worksheets("Pivot").Range("E13").CurrentRegion.ClearContents
For Each PI In PF.PivotItems
If PI.Visible Then
Worksheets("Pivot").Range("E13").Offset(i, 0) = PI.Caption
i = i + 1
End If
Next
End Sub