• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

PİVOT TABLO OTOMATİK FİLİTRE SEÇİMİ

Merhaba.

Alt taraftan Sayfa1'in adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
açılan VBA ekranında sağdaki boş alana aşağıdaki kod blokunu yapıştırın.
Sayfa1 A1 hücresinde değişiklik yaparak (elle yazarak veya veri doğrulama>>listeden seçerek) deneyin.
Rich (BB code): 
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [A1]) Is Nothing Then Exit Sub
    With Sheets("Sayfa2").PivotTables("PivotTable1").PivotFields("TARİH")
        .ClearAllFilters: .CurrentPage = Target.Value
    End With
End Sub
 
Son düzenleme:
Ömer hocam ilginize çok tesekkur ederim,

izninizle hocam bir sorum daha olsa size

Sayfa 1 deki ay dahil geçmiş ayların hepsını sayfa 2 de tabloda sectırsek ve aynı anda Sayfa 3 te Sayfa 1 deki ay hariç geçmiş ayların hepsını tabloda sectırsek makrosu nasıl olur
 
Belgenizde Sayfa3 boş, bu nedenle Sayfa3'e ait belirttiğiniz hususu anlamadım. Gerekirse yeni örnek belge ekleyin.

Özet tabloda; ilk aydan, Sayfa1 A1 hücresinde seçilen aya kadarki ayların seçili hale gelmesi için önceki cevabımda verdiğim kodu
aşağıdakiyle değiştirin.
CSS: 
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [A1]) Is Nothing Then Exit Sub
    With Sheets("Sayfa2").PivotTables("PivotTable1").PivotFields("TARİH")
        .ClearAllFilters
        .PivotItems("(blank)").Visible = False
        .EnableMultiplePageItems = True
        sat = WorksheetFunction.Match(Target, Sheets("Sayfa2").[S:S], 0)
        For dnm = 2 To Sheets("Sayfa2").Cells(Rows.Count, "S").End(3).Row
            If dnm > sat Then: .PivotItems(Sheets("Sayfa2").Cells(dnm, "S").Value).Visible = False
            If dnm <= sat Then: .PivotItems(Sheets("Sayfa2").Cells(dnm, "S").Value).Visible = True
        Next
    End With
End Sub
 
Hocam verdiğiniz kodu ekledığımde sayfa 1 deki ilgili aya kadar değilde her seferınde tüm ayları sectı

sayfa 3 için örnek excel yukledım

örn olarak sayfa 1 de 2019/3 yazdığımda sayfa 2 de 2019/1, 2019/2, 2019/3 aylarını, aynı zamanda sayfa 3 te 2019/1,2019/2 ayları otomatik seçecek

https://dosya.co/s1aggxigrwtv/Örnek_Excel.xlsx.html
 
Alt taraftan Sayfa1'in adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
açılan VBA ekranında sğdaki boş alana aşağıdaki kod blokunu yapıştırın.
CSS: 
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [A1]) Is Nothing Then Exit Sub
    Sheets("Sayfa2").PivotTables("PivotTable1").PivotFields("TARİH").ClearAllFilters
    Sheets("Sayfa3").PivotTables("PivotTable1").PivotFields("TARİH").ClearAllFilters
    
    Sheets("Sayfa2").PivotTables("PivotTable1").PivotFields("TARİH").EnableMultiplePageItems = True
    Sheets("Sayfa3").PivotTables("PivotTable1").PivotFields("TARİH").EnableMultiplePageItems = True
sat = WorksheetFunction.Match(Target, Sheets("Sayfa2").[S:S], 0)
For dnm = sat To 13
    Sheets("Sayfa2").PivotTables("PivotTable1").PivotFields("TARİH").PivotItems(Sheets("Sayfa2").Cells(dnm + 1, "S").Value).Visible = False
    Sheets("Sayfa3").PivotTables("PivotTable1").PivotFields("TARİH").PivotItems(Sheets("Sayfa3").Cells(dnm, "R").Value).Visible = False
Next
    Sheets("Sayfa2").PivotTables("PivotTable1").PivotFields("TARİH").PivotItems("(blank)").Visible = False
    Sheets("Sayfa3").PivotTables("PivotTable1").PivotFields("TARİH").PivotItems("(blank)").Visible = False
    
End Sub
 
Son düzenleme:
Sayfayı yenileyerek bir önceki cevabımı kontrol ediniz.
 
Eyvallah, önemli olan ihtiyacın görülmesi.
İyi çalışmalar dilerim.
.
 
Bu çalışmayı otomatik değilde bir tuşa atasak kodu nasıl olur
 
Kodu düğmeyle çalıştırmak için;
-- If Intersect... satırı yerine If [A1]="" Then Exit Sub satırı yazın,
-- If Intersect... satırı hariç kod içeriğini yeni bir makronun içine alın,
-- kod'daki Target yerine de kriterin alınacağı hücre adresini [A1] gibi yazın.
.
 
Anlamadım aynı değerlerle kodu revize etme sansınız yokmu :(
 
Sayın @zeugma35 .
-- Sayfaya bir adet düğme/şekil/metin kutusu ekleyin,
-- Aşağıdaki kodu Sayfa1'in kod bölümüne veya boş bir Module yapıştırın,
-- Sayfaya eklediğiniz şekil/düğme/metin kutusuyla aşağıdaki kodu ilişkilendirin.
Kriter değerin Sayfa1 A1 hücresine yazıldığı varsayıldı.
Rich (BB code): 
Sub OZET_TABLOLAR()

On Error Resume Next
If Sheets("Sayfa1").[A1] = "" Then Exit Sub
    Sheets("Sayfa2").PivotTables("PivotTable1").PivotFields("TARİH").ClearAllFilters
    Sheets("Sayfa3").PivotTables("PivotTable1").PivotFields("TARİH").ClearAllFilters
  
    Sheets("Sayfa2").PivotTables("PivotTable1").PivotFields("TARİH").EnableMultiplePageItems = True
    Sheets("Sayfa3").PivotTables("PivotTable1").PivotFields("TARİH").EnableMultiplePageItems = True
sat = WorksheetFunction.Match(Sheets("Sayfa1").[A1], Sheets("Sayfa2").[S:S], 0)
For dnm = sat To 13
    Sheets("Sayfa2").PivotTables("PivotTable1").PivotFields("TARİH").PivotItems(Sheets("Sayfa2").Cells(dnm + 1, "S").Value).Visible = False
    Sheets("Sayfa3").PivotTables("PivotTable1").PivotFields("TARİH").PivotItems(Sheets("Sayfa3").Cells(dnm, "R").Value).Visible = False
Next
    Sheets("Sayfa2").PivotTables("PivotTable1").PivotFields("TARİH").PivotItems("(blank)").Visible = False
    Sheets("Sayfa3").PivotTables("PivotTable1").PivotFields("TARİH").PivotItems("(blank)").Visible = False
  
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst