Note: The other languages of the website are Google-translated. Back to English

Pivot Tablo filtresini Excel'deki belirli bir hücreye nasıl bağlayabilirim?

Bir Pivot Tablo filtresini belirli bir hücreye bağlamak ve Pivot Tabloyu hücre değerine göre filtrelemek istiyorsanız, bu makaledeki yöntem size yardımcı olabilir.

Pivot Tablo filtresini VBA kodu ile belirli bir hücreye bağlayın


Pivot Tablo filtresini VBA kodu ile belirli bir hücreye bağlayın

Filtre işlevini bir hücre değerine bağlayacağınız Pivot Tablo, bir filtre alanı içermelidir (filtre alanının adı, aşağıdaki VBA kodunda önemli bir rol oynar).

Aşağıdaki Pivot Tabloyu örnek olarak alın, Pivot Tablodaki filtre alanına denir Kategorilerve iki değer içerir "Giderler"Ve"Satış”. Pivot Tablo filtresini bir hücreye bağladıktan sonra, Pivot Tabloyu filtrelemek için uygulayacağınız hücre değerleri "Giderler" ve "Satışlar" olmalıdır.

1. Lütfen Pivot Tablosunun filtre işlevine bağlayacağınız hücreyi seçin (burada H6 hücresini seçiyorum) ve filtre değerlerinden birini hücreye önceden girin.

2. Hücreye bağlayacağınız Pivot Tabloyu içeren çalışma sayfasını açın. Sayfa sekmesine sağ tıklayın ve seçin Kodu Görüntüle bağlam menüsünden. Ekran görüntüsüne bakın:

3. içinde Uygulamalar için Microsoft Visual Basic penceresinde, VBA kodunu Kod penceresine kopyalayın.

VBA kodu: Pivot Tablo filtresini belirli bir hücreye bağlayın

Private Sub Worksheet_Change(ByVal Target As Range)
'Update by Extendoffice 20180702
    Dim xPTable As PivotTable
    Dim xPFile As PivotField
    Dim xStr As String
    On Error Resume Next
    If Intersect(Target, Range("H6")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xPTable = Worksheets("Sheet1").PivotTables("PivotTable2")
    Set xPFile = xPTable.PivotFields("Category")
    xStr = Target.Text
    xPFile.ClearAllFilters
    xPFile.CurrentPage = xStr
    Application.ScreenUpdating = True
End Sub

notlar:

1) "Sheet1"Açılan çalışma sayfasının adıdır.
2) "Özet Tablo2", Filtre işlevini bir hücreye bağlayacağınız Pivot Tablonun adıdır.
3) Pivot tablodaki filtreleme alanına "Kategoriler".
4) Başvurulan hücre H6'dır. Bu değişken değerleri ihtiyaçlarınıza göre değiştirebilirsiniz.

4. Tuşuna basın. Ara Toplam + Q kapatmak için anahtarlar Uygulamalar için Microsoft Visual Basic pencere.

Şimdi Pivot Tablonun filtre işlevi H6 hücresine bağlıdır.

H6 hücresini yenileyin, ardından Pivot Tablodaki ilgili veriler mevcut değere göre filtrelenir. Ekran görüntüsüne bakın:

Hücre değerini değiştirirken, Pivot Tablodaki filtrelenmiş veriler otomatik olarak değiştirilecektir. Ekran görüntüsüne bakın:


Bir certian sütunundaki hücre değerine göre tüm satırları kolayca seçin:

The Belirli Hücreleri Seçin yarar Kutools for Excel aşağıda gösterilen ekran görüntüsü gibi Excel'deki bir certian sütunundaki hücre değerine göre tüm satırları hızlı bir şekilde seçmenize yardımcı olabilir. Hücre değerine göre tüm satırları seçtikten sonra, bunları Excel'de ihtiyaç duyduğunuz şekilde manuel olarak taşıyabilir veya yeni bir konuma kopyalayabilirsiniz.
Şimdi indirin ve deneyin! (30- günlük ücretsiz iz)


İlgili yazılar:


En İyi Ofis Üretkenliği Araçları

Kutools for Excel Sorunlarınızın Çoğunu Çözer ve Verimliliğinizi% 80 Artırır

  • Yeniden: Hızlıca yerleştirin karmaşık formüller, grafikler ve daha önce kullandığınız her şey; Hücreleri Şifrele şifre ile; Posta Listesi Oluşturun ve e-posta gönder ...
  • Süper Formül Çubuğu (birden çok metin ve formül satırını kolayca düzenleyin); Okuma Düzeni (çok sayıda hücreyi kolayca okuyun ve düzenleyin); Filtrelenmiş Aralığa Yapıştır...
  • Hücreleri / Satırları / Sütunları Birleştirme Veri kaybetmeden; Bölünmüş Hücre İçeriği; Yinelenen Satırları / Sütunları Birleştirme... Yinelenen Hücreleri Önleyin; Aralıkları Karşılaştır...
  • Yinelenen veya Benzersiz'i seçin Satırlar; Boş Satırları Seçin (tüm hücreler boştur); Süper Bul ve Bulanık Bul Birçok Çalışma Kitabında; Rastgele Seçim ...
  • Tam kopya Formül referansını değiştirmeden Birden Çok Hücre; Otomatik Referans Oluştur Birden Çok Sayfaya; Madde İşaretleri Ekle, Onay Kutuları ve daha fazlası ...
  • Metni Çıkar, Metin Ekle, Konuma Göre Kaldır, Alanı Kaldır; Sayfalama Alt Toplamları Oluşturma ve Yazdırma; Hücre İçeriği ve Yorumları Arasında Dönüştür...
  • Süper Filtre (filtre şemalarını kaydedin ve diğer sayfalara uygulayın); Gelişmiş Sıralama ay / hafta / gün, sıklık ve daha fazlasına göre; Özel Filtre kalın, italik ...
  • Çalışma Kitaplarını ve Çalışma Sayfalarını Birleştirin; Tabloları anahtar sütunlara göre birleştirin; Verileri Birden Çok Sayfaya Bölme; Toplu dönüştürme xls, xlsx ve PDF...
  • 300'den fazla güçlü özellik. Office / Excel 2007-2021 ve 365'i destekler. Tüm dilleri destekler. Kuruluşunuzda veya kuruluşunuzda kolay devreye alma. Tam özellikler 30 günlük ücretsiz deneme. 60 günlük para iade garantisi.
kte sekmesi 201905

Office Tab, Office'e Sekmeli Arayüz Getirir ve İşinizi Çok Daha Kolay Hale Getirir

  • Word, Excel, PowerPoint'te sekmeli düzenlemeyi ve okumayı etkinleştirin, Publisher, Access, Visio ve Project.
  • Yeni pencereler yerine aynı pencerenin yeni sekmelerinde birden çok belge açın ve oluşturun.
  • Üretkenliğinizi% 50 artırır ve her gün sizin için yüzlerce fare tıklamasını azaltır!
ofis tabanı
Yorumları sıralama ölçütü
Yorumlar (36)
Henüz derecelendirme yok. İlk değerlendiren siz olun!
Bu yorum sitedeki moderatör tarafından en aza indirildi
kodda yalnızca bir hedef olduğundan çoklu alanda nasıl yapılır
Bu yorum sitedeki moderatör tarafından en aza indirildi
Selam Frank
Sory bu konuda sana yardımcı olamaz.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Pivot Tabloya bağlı hücre, bu durumda H6, başka bir çalışma sayfasındaysa? Kodu nasıl değiştirir?
Bu yorum sitedeki moderatör tarafından en aza indirildi
ya 1'den fazla pivot tablom varsa ve 1 hücreye bağlanmak için. Kodu nasıl değiştirebilirim?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Jeri,
Üzgünüm bu konuda size yardımcı olamam. Forumumuza herhangi bir soru göndermeye hoş geldiniz: https://www.extendoffice.com/forum.html Excel profesyonellerinden veya diğer Excel hayranlarından daha fazla Excel desteği almak için.
Bu yorum sitedeki moderatör tarafından en aza indirildi
bunları bulun ve Array(),Intersect(), Worksheets(), PivotFields() içinde değiştirin

Özet Tablo1
Özet Tablo2
Özet Tablo3
Özet Tablo4
H1
SayfaAdı
Alan adı




Private Sub Worksheet_Change(ByVal Target As Range)
'Update by Extendoffice 20180702
    Dim xPTable As PivotTable
    Dim xPFile As PivotField
    Dim xPTabled As PivotTable
    Dim xPFiled As PivotField
    Dim xStr As String
    On Error Resume Next
    '리스트 만들기
    Dim listArray() As Variant
    listArray = Array("PivotTable1", "PivotTable2", "PivotTable3", "PivotTable4")
    If Intersect(Target, Range("H1")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    For i = 0 To UBound(listArray)
        Set xPTable = Worksheets("SheetName").PivotTables(listArray(i))
        Set xPFile = xPTable.PivotFields("FieldName")
        'MsgBox (listArray(i))
        xStr = Target.Text
        xPFile.ClearAllFilters
        xPFile.CurrentPage = xStr
    Next
        Application.ScreenUpdating = True
End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
Boa tarde...! Ótima publicação, como faço para utilizar o filtro em duas ou mais tabelas dinâmicas...? Agradeço desde já.

Tünaydın...! Harika yayıncılık, filtreyi iki veya daha fazla PivotTable'da nasıl kullanırım ...? Şimdiden teşekkürler.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Gilmar Alves,
Üzgünüm bu konuda size yardımcı olamam. Forumumuza herhangi bir soru göndermeye hoş geldiniz: https://www.extendoffice.com/forum.html Excel profesyonellerinden veya diğer Excel hayranlarından daha fazla Excel desteği almak için.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Çoklu pivot tablo bağlantı sorusunu çözen var mı?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Array(), Worksheets() ve Intersect() içindeki Değerleri Değiştirin



**Bunları bul ve değiştir**
SayfaAdı
E1
Özet Tablo1
Özet Tablo2
Özet Tablo3




Özel Alt Çalışma Alanı_Değiştir (ByVal Target As Range)
'Güncelleme Extendoffice 20180702
xPTable'ı PivotTable Olarak Karartın
PivotField Olarak xPFile'ı Karartın

PivotTable Olarak xPTabled Dim
PivotField Olarak xPFiled Dim

xStr'yi Dize Olarak Kıs



On Error Resume Next

'리스트 만들기
Dim listArray() Varyant Olarak
listArray = Array("PivotTable1", "PivotTable2", "PivotTable3")



Eğer Intersect(Hedef, Aralık("E1")) Hiçbir Şey Değilse Sub'dan Çıkın
Application.ScreenUpdating = Yanlış

i = 0 için UBound(listArray) için

xPTable = Çalışma Sayfaları ("SayfaAdı") olarak ayarlayın. PivotTables(listArray(i))
xPFile = xPTable.PivotFields("Company_ID") olarak ayarlayın

xStr = Hedef.Metin
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr



Sonraki

Application.ScreenUpdating = True



End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
Ciao, modo che il filtro della pivot si setti sul valore della cella'da uzak başına bir ücret los stesso esempio, sto provando,
riesco olmayan bir farla funzionare.

Quale passaggio manca nella descrizione sopra mı?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba,
Herhangi bir hata istemi aldınız mı? Excel sürümünüz gibi sorununuz hakkında daha ayrıntılı bilgiye ihtiyacım var. Ve sakıncası yoksa, verilerinizi yeni bir çalışma kitabında oluşturmaya çalışın ve tekrar deneyin veya verilerinizin ekran görüntüsünü alıp buraya yükleyin.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba,

Bunu sütun filtresi için çalıştırmaya çalıştım ama çalışmıyor gibi görünüyor. Bunun için başka bir koda ihtiyacım var mı?

Teşekkürler
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Justin,
Herhangi bir hata istemi aldınız mı? Sorununuz hakkında daha ayrıntılı bilgiye ihtiyacım var.
Kodu uygulamadan önce, "sayfanın adı""pivot tablonun adı""pivot tablo filtresinin adı" ve hücre pivot tabloyu temel alarak filtrelemek istiyorsunuz (bkz.
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/4.png
Bu yorum sitedeki moderatör tarafından en aza indirildi
merhaba kristal,

Yardımınız için teşekkürler. Sorun, işlevin bir nedenden dolayı hiçbir şey yapmamasıdır. Bazı açıklamalar:

Özet adı: Order_Comp_B2C
Sayfa Adı: Hesaplama Sayfası
Filtre adı: Hafta Numarası (Veri dosyasındaki "Hafta Numarasını Gönderme" olan bu adı değiştirdim)
Değiştirilecek hücre: O26 ve O27 (bu aralıkta olmalıdır)

Bu pivotta, sütunlar için filtreyi değiştirmeye çalışıyorum, PivotTable Fields menüsündeki filtre alanında hiçbir şeyim yok.

benim kodum:

Özel Alt Çalışma Alanı_Değiştir (ByVal Target As Range)
'Güncelleme Extendoffice 20180702
xPTable'ı PivotTable Olarak Karartın
PivotField Olarak xPFile'ı Karartın
xStr'yi Dize Olarak Kıs
On Error Resume Next
Eğer Intersect(Target, Range("O26")) Hiçbir Şey Değilse, Sub Exit Sub
Application.ScreenUpdating = Yanlış
xPTable = Worksheets("Hesaplama Sayfası") olarak ayarlayın.PivotTables("Order_Comp_B2C")
xPFile = xPTable.PivotFields ("Hafta Numarası") olarak ayarlayın
xStr = Hedef.Metin
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub

Teşekkürler,

Justin
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Justin Teeuw,
Değiştirdim Pivot adı, sayfa adı, filtre adı ve değiştirilecek hücre yukarıda bahsettiğiniz koşullara ve sağladığınız VBA kodunu denedim, benim durumumda iyi çalışıyor. Aşağıdaki GIF'e veya ekteki çalışma kitabına bakın.
Yeni bir çalışma kitabı oluşturup kodu tekrar dener misiniz?
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/6.gif
Bu yorum sitedeki moderatör tarafından en aza indirildi
merhaba kristal,

Pivotun ekran görüntüsünü ekledim, kırmızı kutu hücre değerine göre değiştirmek istediğim filtre.

Tercihen, birden çok hafta sayısını gösteren bir hücre aralığı kullanmak istiyorum.

Teşekkürler,

Justin
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Justin,
Maalesef sayfada eklediğiniz ekran görüntüsünü görmedim. Belki sayfada bir hata vardır.
Hala sorunu çözmeniz gerekiyorsa, bana zxm@addin99.com aracılığıyla e-posta gönderin. Rahatsızlıktan dolayı özür dileriz.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Justin Teeuw
Lütfen aşağıdaki VBA kodunu deneyin. Umarım yardımcı olabilirim.

Private Sub Worksheet_Change(ByVal Target As Range)
    'Update by Extendoffice 20220706
    Dim I As Integer
    Dim xFilterStr1, xFilterStr2 As String
    On Error Resume Next
    If Intersect(Target, Range("O26:O27")) Is Nothing Then Exit Sub
    'Application.ScreenUpdating = False
    
    xFilterStr1 = Range("O26").Value
    xFilterStr2 = Range("O27").Value
    ActiveSheet.PivotTables("Order_Comp_B2C").PivotFields("Week Number"). _
        ClearAllFilters
    If xFilterStr1 = "" And xFilterStr2 = "" Then Exit Sub
    ActiveSheet.PivotTables("Order_Comp_B2C").PivotFields("Week Number"). _
        EnableMultiplePageItems = True
    xCount = ActiveSheet.PivotTables("Order_Comp_B2C").PivotFields("Week Number").PivotItems.Count

    For I = 1 To xCount
        If I <> xFilterStr1 And I <> xFilterStr2 Then
            ActiveSheet.PivotTables("Order_Comp_B2C").PivotFields("Week Number").PivotItems(I).Visible = False
        Else
            ActiveSheet.PivotTables("Order_Comp_B2C").PivotFields("Week Number").PivotItems(I).Visible = True
        End If
    Next

    'Application.ScreenUpdating = True
End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
Normal bir excell için kullandım ve işe yaradı.Ama bir olap çalışma yaprağı için kullanamadım. belki biraz değiştirmem gerekir?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba maziaritib4 TİB,
Yöntem yalnızca Microsoft Excel için geçerlidir. Rahatsızlıktan dolayı özür dileriz.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Justin,

Bu mükemmel çalıştı, ancak bu kuralın aynı sayfada birden fazla PivotTable'a uygulanıp uygulanamayacağını merak ediyorum.

Teşekkürler,
James
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba James,

Evet bu mümkün, bunun için kullandığım kod (4 pivot ve 2 hücre referansı):

Özel Alt Çalışma Alanı_Değiştir (ByVal Target As Range)
Tamsayı Olarak Dim I
Dim xFilterStr1, xFilterStr2, yFilterstr1, yfilterstr2 As Dize
On Error Resume Next
Eğer Intersect(Target, Range("O26:P27")) Hiçbir Şey Değilse Exit Sub

xFilterStr1 = Aralık("O26").Değer
xFilterStr2 = Aralık("O27").Değer
yFilterstr1 = Aralık("p26").Değer
yfilterstr2 = Aralık("p27").Değer
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Hafta Numarası"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Hafta Numarası"). _
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Hafta Numarası"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Hafta Numarası"). _
Tüm Filtreleri Temizle

xFilterStr1 = "" Ve xFilterStr2 = "" Ve yFilterstr1 = "" Ve yfilterstr2 = "" ise, Sonra Sub'dan Çıkın
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Hafta Numarası"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Hafta Numarası"). _
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Hafta Numarası"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Hafta Numarası"). _
EnableMultiplePageItems = Doğru

xCount = ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Hafta Numarası").PivotItems.Count
xCount = ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Hafta Numarası").PivotItems.Count
yCount = ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Hafta Numarası").PivotItems.Count
yCount = ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Hafta Numarası").PivotItems.Count

I için = 1'den xCount'a
Eğer <> xFilterStr1 Ve Ben <> xFilterStr2 O zaman
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Hafta Numarası").PivotItems(I).Visible = False
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Hafta Numarası").PivotItems(I).Visible = False
başka
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Hafta Numarası").PivotItems(I).Visible = True
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Hafta Numarası").PivotItems(I).Visible = True
Eğer son
Sonraki

I = 1 için yCount için
Eğer ben <> yFilterstr1 Ve ben <> yfilterstr2 O zaman
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Hafta Numarası").PivotItems(I).Visible = False
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Hafta Numarası").PivotItems(I).Visible = False
başka
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Hafta Numarası").PivotItems(I).Visible = True
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Hafta Numarası").PivotItems(I).Visible = True
Eğer son
Sonraki

End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
Array(), Worksheets() ve Intersect() içindeki Değerleri Değiştirin



**Bunları bul ve değiştir**
SayfaAdı
E1
Özet Tablo1
Özet Tablo2
Özet Tablo3




Özel Alt Çalışma Alanı_Değiştir (ByVal Target As Range)
'Güncelleme Extendoffice 20180702
xPTable'ı PivotTable Olarak Karartın
PivotField Olarak xPFile'ı Karartın

PivotTable Olarak xPTabled Dim
PivotField Olarak xPFiled Dim

xStr'yi Dize Olarak Kıs



On Error Resume Next

'리스트 만들기
Dim listArray() Varyant Olarak
listArray = Array("PivotTable1", "PivotTable2", "PivotTable3")



Eğer Intersect(Hedef, Aralık("E1")) Hiçbir Şey Değilse Sub'dan Çıkın
Application.ScreenUpdating = Yanlış

i = 0 için UBound(listArray) için

xPTable = Çalışma Sayfaları ("SayfaAdı") olarak ayarlayın. PivotTables(listArray(i))
xPFile = xPTable.PivotFields("Company_ID") olarak ayarlayın

xStr = Hedef.Metin
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr



Sonraki

Application.ScreenUpdating = True



End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba,

Kod benim için iyi çalışıyor. Ancak filtre hedefini otomatik olarak güncellemek için pivot tabloyu alamıyorum. Benim durumumdaki hedef bir formüldür [TARİH(D18,S14,C18)]. Kod yalnızca hedef hücreye çift tıklayıp enter tuşuna bastığımda çalışıyor.

teşekkür ederim
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba,

Bu kod mükemmel çalışıyor. Ancak pivot tabloyu otomatik olarak güncelleme kodunu alamıyorum. Benim için hedef değer, D18'de neyin seçili olduğuna bağlı olarak değişen bir formüldür (=TARİH(D18,..,..)). Pivot tabloyu güncellemek için hedef hücreye çift tıklayıp enter tuşuna basmam gerekiyor. etrafında yol var mı?

teşekkür ederim
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba ST,
Hedef değerinizin H6'da olduğunu ve D18'deki değere bağlı olarak değiştiğini varsayalım. Bir pivot tabloyu bu hedef değere göre filtrelemek için. Aşağıdaki VBA kodu yardımcı olabilir. Lütfen bir deneyin.
Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 2022/07/22
Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String
Dim xBoolean As Boolean
Dim xItsRG As Range
Dim xDDs As Range
Dim xDs As Range
On Error Resume Next

xBoolean = False
Set xRg = Range("h6")

Set xItsRG = Intersect(Target, xRg)
Set xDDs = Intersect(Target.DirectDependents, xRg)
Set xDs = Intersect(Target.Dependents, xRg)
If Not (xItsRG Is Nothing) Then
    xBoolean = True
ElseIf Not (xDDs Is Nothing) Then
    xBoolean = True
ElseIf Not (xDs Is Nothing) Then
    xBoolean = True
End If


If Not xBoolean Then Exit Sub

Application.ScreenUpdating = False
Set xPTable = Worksheets("Sheet1").PivotTables("Pivot Table 1")
Set xPFile = xPTable.PivotFields("Category")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True

End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Crysal,

Kodun üzerine bir satır ekledim: Dim xRg As Range

Kod, hedef değiştirildiğinde tarihleri ​​otomatik olarak sıfırlamaz. Yapmaya çalıştığım şeyi kopyalayan bir excel dosyam var, ancak bu web sitesine ek ekleyemiyorum. D3 (hedef = DATE(A15,B15,C15)) A15, B15 ve C15 ile bağlantılı bir denkleme sahiptir. A15, B15 ve C15 üzerindeki herhangi bir değer değiştirildiğinde, pivot tablo filtre yok olarak sıfırlanır. Bu konuda bana yardım eder misin?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba ST,
Ne demek istediğini pek anlamıyorum. Sizin durumunuzda, özet tabloyu filtrelemek için hedef hücre D3'ün değeri kullanılır. D3 hedef hücresindeki formül, referans hücrelerdeki değerlere göre değişecek olan A15, B15 ve C15 hücrelerinin değerlerine başvurur. A15, B15 ve C15 üzerindeki herhangi bir değer değiştirildiğinde, hedef hücredeki değer, pivot tablonun filtre koşullarını karşılıyorsa, pivot tablo otomatik olarak filtrelenecektir. Hedef hücredeki değer, özet tablonun filtreleme ölçütlerini karşılamıyorsa, özet tablo otomatik olarak filtre yok durumuna sıfırlanacaktır.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Sizinle bir excel dosyası paylaşmanın bir yolu olup olmadığından emin değilim. Bir tarih olan hedef değerim, diğer hücrelerdeki değişikliklere göre değişirse. Pivot tabloyu güncellemek için hedef hücreye çift tıklamalı ve enter tuşuna basmalıyım (hücreye formül girdikten sonra yaptığınız gibi)
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Sagar T,
Kod güncellendi. Lütfen bir deneyin. Geri bildiriminiz için teşekkürler.
Koddaki çalışma sayfası, pivot tablo ve filtre adlarını değiştirmeyi unutmayın. Veya test için aşağıdaki yüklenen çalışma kitabını indirebilirsiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20220805
Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String
Dim xBoolean As Boolean
Dim xItsRG As Range
Dim xDDs As Range
Dim xDs As Range
On Error Resume Next

xBoolean = False
Set xRg = Range("D3")

Set xItsRG = Intersect(Target, xRg)
Set xDDs = Intersect(Target.DirectDependents, xRg)
Set xDs = Intersect(Target.Dependents, xRg)
If Not (xItsRG Is Nothing) Then
    xBoolean = True
ElseIf Not (xDDs Is Nothing) Then
    xBoolean = True
ElseIf Not (xDs Is Nothing) Then
    xBoolean = True
End If


If Not xBoolean Then Exit Sub
xStr = Format(xRg.Text, "m/d/yyyy")
Application.ScreenUpdating = False
Set xPTable = Worksheets("Sheet2").PivotTables("PivotTable1")
Set xPFile = xPTable.PivotFields("Date")
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True

End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
bunları bulun ve Array(),Intersect(), Worksheets(), PivotFields() içinde değiştirin

Özet Tablo1
Özet Tablo2
Özet Tablo3
Özet Tablo4
H1
SayfaAdı
Alan adı




Private Sub Worksheet_Change(ByVal Target As Range)
'Update by Extendoffice 20180702
    Dim xPTable As PivotTable
    Dim xPFile As PivotField
    Dim xPTabled As PivotTable
    Dim xPFiled As PivotField
    Dim xStr As String
    On Error Resume Next
    '리스트 만들기
    Dim listArray() As Variant
    listArray = Array("PivotTable1", "PivotTable2", "PivotTable3", "PivotTable4")
    If Intersect(Target, Range("H1")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    For i = 0 To UBound(listArray)
        Set xPTable = Worksheets("SheetName").PivotTables(listArray(i))
        Set xPFile = xPTable.PivotFields("FieldName")
        'MsgBox (listArray(i))
        xStr = Target.Text
        xPFile.ClearAllFilters
        xPFile.CurrentPage = xStr
    Next
        Application.ScreenUpdating = True
End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
2 Ocak 2'de 1'da en çok oynanan oyun nasıl oynanır? ilk XNUMX yılda mı?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Алексей,

Lütfen bu yorumdaki VBA kodunun olup olmadığını kontrol edin. #38754 yardımcı olabilir.
Bu yorum sitedeki moderatör tarafından en aza indirildi
H6'yı en iyi şekilde kullanmak için ne yapmalısınız? nasıl olur? подскажите пожалуйста.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Алексей,

Kodu değiştirmeniz gerekmez, sadece VBA kodunu başvurmak istediğiniz hücrenin çalışma sayfasına ekleyin.
Örneğin, " adlı bir pivot tabloyu filtrelemek istiyorsanız,Özet Tablo1"Olarak Sheet2 hücrenin değerine göre H6 in Sheet3, lütfen sağ tıklayın Sheet3 çalışma sayfası sekmesini tıklayın Kodu Görüntüle sağ tıklama menüsünden ve ardından kodu şuraya ekleyin: Sayfa3 (Kod) pencere.
Buraya henüz hiç yorum yapılmamış
Lütfen yorum yazın
Misafir olarak yayınlama
×
Bu gönderiyi değerlendirin:
0   Karakterler
Önerilen Konumlar

Bizi takip et

Telif Hakkı © 2009 - www.extendoffice.com. | Tüm hakları Saklıdır. Tarafından desteklenmektedir ExtendOffice. | | | Site Haritası
Microsoft ve Office logosu, Microsoft Corporation'ın Amerika Birleşik Devletleri ve / veya diğer ülkelerdeki ticari markaları veya tescilli ticari markalarıdır.
Sectigo SSL ile korunmaktadır