Çoklu Özet Filtre Seçimini Kodda Tanımlamak

[baydeniro]

Merhaba Arkadaşlar,
G1 hücresinde sadece Türü "W" ve "X" olanları filtrelemeyi kodla yapmak istiyorum. Ama W-X i seç şeklinde olmuyor. Diğer türleri FALSE yaparak filtreliyor. TÜR sayısı zamanla artacak ama filtreleme ölçütüm hep aynı olacak yani W ve X. Kod aşağıdaki gibi oluyor. Filtre olarak sadece W ve X nasıl seçtirebiliriz (TRUE)

Sub Macro1()
Range("G1").Select
ActiveSheet.PivotTables("PivotTable2").PivotFields("Tür").CurrentPage = "(All)"
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Tür")
.PivotItems("J").Visible = False
.PivotItems("T").Visible = False
End With
End Sub

 

[Ömer]

Merhaba,

Deneyiniz.

Sub Macro1()
    Dim deg
    Range("G1").Select
    ActiveSheet.PivotTables("PivotTable2").PivotFields("Tür").CurrentPage = "(All)"
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Tür")
        .ClearAllFilters
        .EnableMultiplePageItems = True
        For Each deg In .PivotItems
            deg.Visible = False
            Select Case deg
                Case "W", "X" 'eklenecek şartlar
                deg.Visible = True
            End Select
        Next deg
    End With
End Sub

 

[baydeniro]

Merhaba,

Deneyiniz.

Sub Macro1()
    Dim deg
    Range("G1").Select
    ActiveSheet.PivotTables("PivotTable2").PivotFields("Tür").CurrentPage = "(All)"
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Tür")
        .ClearAllFilters
        .EnableMultiplePageItems = True
        For Each deg In .PivotItems
            deg.Visible = False
            Select Case deg
                Case "W", "X" 'eklenecek şartlar
                deg.Visible = True
            End Select
        Next deg
    End With
End Sub

Üstad çok teşekkür ederim, harika oldu. Elinize sağlık. Filtrelenecek veriler hem sayısal olarak hem de içerik değişiyor, bu durumda filtre verilerini hücreden belirlemek mümkün mü !

 

[Ömer]

Sorunuzu anlayamadım. Daha detaylı ve örnek dosya üzerinde açıklar mısınız.

 

[baydeniro]

Sorunuzu anlayamadım. Daha detaylı ve örnek dosya üzerinde açıklar mısınız.

Teşekkür ederim üstad. Yeni dosyayı ekledim.

 

[Ömer]

Deneyiniz.

Sub OZETTABLO()
    Dim deg, dizi(), a As Range, s As Byte
    For Each a In Range("B2:D2")
        If a <> "" Then
            ReDim Preserve dizi(s)
            dizi(s) = a.Value
            s = s + 1
        End If
    Next a
    Range("G1").Select
    If s = 0 Then Exit Sub
    ActiveSheet.PivotTables("PivotTable2").PivotFields("Tür").CurrentPage = "(All)"
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Tür")
        .ClearAllFilters
        .EnableMultiplePageItems = True
        For Each deg In .PivotItems
            For j = 0 To UBound(dizi)
                If dizi(j) = deg Then
                    deg.Visible = True
                    Exit For
                Else
                    deg.Visible = False
                End If
            Next j
        Next deg
    End With
End Sub

 

[baydeniro]

Deneyiniz.

Sub OZETTABLO()
    Dim deg, dizi(), a As Range, s As Byte
    For Each a In Range("B2:D2")
        If a <> "" Then
            ReDim Preserve dizi(s)
            dizi(s) = a.Value
            s = s + 1
        End If
    Next a
    Range("G1").Select
    If s = 0 Then Exit Sub
    ActiveSheet.PivotTables("PivotTable2").PivotFields("Tür").CurrentPage = "(All)"
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Tür")
        .ClearAllFilters
        .EnableMultiplePageItems = True
        For Each deg In .PivotItems
            For j = 0 To UBound(dizi)
                If dizi(j) = deg Then
                    deg.Visible = True
                    Exit For
                Else
                    deg.Visible = False
                End If
            Next j
        Next deg
    End With
End Sub

Üstad çok teşekkürler, aklınıza sağlık. Mükemmel çalışıyor. Sağlıcakla kalın