vba ile özet tablo çoklu veri filtreleme

[bebar]

Merhaba,

Sayfamda bulunan verileri farklı bir sekmede bulunan pivotu filtrelemek için kullanmak istiyorum. Aşağıdaki gibi bir kod oluşturdum fakat çalışmıyor. yardımcı olursanız memnun olurum.

Sub mkr()
Dim s1 As Worksheet
Dim s2 As Worksheet
Dim wf As WorksheetFunction
    Set s1 = Sheets("Veri")
    Set s2 = Sheets("Rapor")
    Set wf = Application.WorksheetFunction
    Dim x As Integer

    Dim PivotStr() As String
    ReDim PivotStr(x)
    Application.ScreenUpdating = False
   
    x = s2.Cells(17, "O").End(xlUp).Row
    For I = 3 To x
        PivotStr(I) = s2.Cells(I, "O")
    Next I
   
    s1.PivotTables("PivotTable7").PivotFields("Ay").VisibleItemsList = Array(PivotStr)

End Sub

 

[bebar]

yardımcı olabilecek bir arkadaş yok mudur??

 

[Korhan Ayhan]

Örnek dosya ekleyebilir misiniz?

 

[bebar]

örnek dosyam ektedir.

 

[bebar]

2 gündür bir çok örnek inceledim ama sorunumu çözemedim.Tekrardan yazmak istemezdim fakat konu benim çok önemli. istediğim mümkün değilse bile bilgilendirirseniz çok memnun olurum.

 

[maliex]

kayıt makrosundan yardım almayı denedinizmi ?

 

[bebar]

verilerim değişken olduğu için kayıt makrosunu kullanamıyorum.
Ayrıca bir çok özet tablo kullandığım için dilimleyici işimi görmüyor.

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub FilterPivotItems()
    Dim S1 As Worksheet, S2 As Worksheet, Find_Criteria As Range
    Dim P_Table As PivotTable, P_Item As PivotItem, P_Criteria As Range
   
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
   
    Set P_Criteria = S2.Range("O3:O4")
   
    Set P_Table = S1.PivotTables("PivotTable1")
   
    P_Table.PivotFields("Ay").ClearAllFilters
   
    For Each P_Item In P_Table.PivotFields("Ay").PivotItems
        Set Find_Criteria = P_Criteria.Find(P_Item.Caption, , , xlWhole)
        If Not Find_Criteria Is Nothing Then
            P_Item.Visible = True
        Else
            P_Item.Visible = False
        End If
    Next

    MsgBox "Filtreleme işlemi tamamlanmıştır.", vbInformation
End Sub

 

[bebar]

Hocam çok teşekkür ederim.
Allah razı olsun.