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

baydeniro

Altın Üye
Katılım
26 Ocak 2007
Mesajlar
4,625
Excel Vers. ve Dili
Ofis 2016
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

228959
 

Ekli dosyalar

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,196
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
Merhaba,

Deneyiniz.
Kod:
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

Altın Üye
Katılım
26 Ocak 2007
Mesajlar
4,625
Excel Vers. ve Dili
Ofis 2016
Merhaba,

Deneyiniz.
Kod:
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

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,196
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
Sorunuzu anlayamadım. Daha detaylı ve örnek dosya üzerinde açıklar mısınız.
 

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,196
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
Deneyiniz.
Kod:
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

Altın Üye
Katılım
26 Ocak 2007
Mesajlar
4,625
Excel Vers. ve Dili
Ofis 2016
Deneyiniz.
Kod:
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
 
Üst