Temat: VBA - jak sprawdzic czy Tabela Przestawna ma filter?

Witam

Od wczoraj zmagam sie z problemem filtra w tabeli przestawnej. Mam makro ktore sprawdza czy filter w kolumnie Nr Zamowienia ma wybrana wartosc 0 i jezeli nie to ustawia go na zero.

Moj problem jest taki ze kod sie wywala jezeli a) kolumna Nr Zamowienia nie ma filtra w ogole lub b) jezeli wartosc jest 0

Potrzebowalbym pomocy z linia kodu, ktora by sprawdzala czy ten filter jest w ogole zalozony i jezeli tak to czy wybrana wartosc jest 0.

Wielkie dzieki!

Temat: VBA - jak sprawdzic czy Tabela Przestawna ma filter?

Jakies pomysly?

Temat: VBA - jak sprawdzic czy Tabela Przestawna ma filter?

Oczywiście wpierw musisz sprawdzić czy dana wartość we filtrze istnieje. Jeśli jej nie będzie nadpiszesz daną w filtrze i się wszystko pokiełbasi.
Troszkę szerzej niż Wojtek:

Dim tp As PivotTable, pole As PivotField, el As PivotItem

Set tp = Sheets("NazwaArkusza").PivotTables("TabelaPrzestawna")

On Error GoTo brak_pola_filtra

Set pole = tp.PageFields("NazwaPolaFiltra")

On Error Resume Next

For Each el In pole.PivotItems

    If el.name = "(blank)" Then Exit For

    If el.name = 0 then msgbox "Jest twoje zero w filtrze TP", vbInformation , "VBATools.pl"

Next

Exit Sub

brak_pola_filtra:

MsgBox "Brak szukanego filtra", vbInformation, "VBATools.pl"

Można rozbudować ten kod jeśli masz wiele warunków.
Niemniej jednak to baza kodu. Wystarczy dopisać gdzie "masz wsadzić sobie" to zero.

Temat: VBA - jak sprawdzic czy Tabela Przestawna ma filter?

Witam,

Ja mam troszkę inny problem. Chodzi mi o to aby plik QR4 był filtrowany po zmiennej FS i tak też się dzieję bo jak wpisana zmienna istnieje to odpowiednie wartości są kopiowane do innego pliku. Schody zaczęły się dziać w momencie gdy zadana wartość FS nie jest znaleziona w filtrze i wtedy makro zamiast wpisać wartości 0 to przepisuje wartości z ostatniego znalezione go FS w PivotField.

Kod poniżej:

Sub GS_weekly()

'

' GS_weekly Makro

'

' Klawisz skrótu: Ctrl+n

'



Dim week As String

Dim FS As String

Dim cost As String

Dim PI As PivotItem



week = Application.InputBox("Podaj numer tygodnia folderu, z którego danych chcesz skorzystać ?")

If TypeName(week) = "Boolean" Then Exit Sub

On Error Resume Next



FS = Application.InputBox("Podaj nr FS, dla którego dane wyciągnę ?")

If TypeName(FS) = "Boolean" Then Exit Sub

On Error Resume Next



cost = Application.InputBox("Podaj kolumnę, w której umieścić dane ?")

If TypeName(cost) = "Boolean" Then Exit Sub

On Error Resume Next



Windows("QR4 WK" & week & ".xlsx").Activate



Sheets("Arkusz3").Activate

  

 With ActiveSheet.PivotTables("Tabela_przestawna_QR4_3").PivotFields("fin_style_id")

    .ClearAllFilters

        For Each PI In .PivotItems

            Select Case PI

            Case "" & FS & "": PI.Visible = True

            Case Else: PI.Visible = False

            End Select

        Next PI

    End With

    ActiveSheet.PivotTables("Tabela_przestawna_QR4_3").PivotFields( _

        "fin_style_id").EnableMultiplePageItems = True



Windows("Bierun Lamination WK" & week & " 2021.xlsm").Activate



Sheets("" & FS & "").Activate



    Range("AI3").Select

    Application.CutCopyMode = False

    ActiveCell.FormulaR1C1 = _

        "=IFERROR(VLOOKUP(RC[-20],'[QR4 WK" & week & ".xlsx]Arkusz3'!R7C1:R100C2,2,FALSE),0)"

    Range("AI3").Select

    Selection.AutoFill Destination:=Range("AI3:AI12"), Type:=xlFillDefault

    Range("AI3:AI12").Select

    Selection.Copy

    Range("" & cost & "3").Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False



    Range("AI15").Select

    Application.CutCopyMode = False

  

    ActiveCell.FormulaR1C1 = _

        "=IFERROR(VLOOKUP(R[-13]C[-33],'[LE WK" & week & ".xlsx]PV_value'!R4C1:R284C2,2,FALSE),0)"

    Range("AI15").Select

    Selection.Copy

    Range("" & cost & "15").Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False



    Range("AI").EntireColumn.Hidden = True

        

End Sub

Ten post został edytowany przez Autora dnia 18.01.21 o godzinie 11:54