Filtreye köprü kurmak

[afk]

Değerli üstadlar merhaba, nette yeterli bir bilgi bulamadığım için konu açmak zorunda kaldım kusura bakmayın.
Şöyle bir istediğim var. Basit bir borç listesi takip etmek istiyorum. 3 adet sayfadan oluşuyor. Borçlu bilgilerinin olduğu Liste sayfası, hesap hareketlerinin olduğu Detay sayfası ve Özet bilgilerin yer aldığı Özet sayfası. Özet sayfasında borçlu numarasını girdiğimizde isim otomatik olarak geliyor. Benim isteğim, Özet sayfasındaki Borçlu adına tıkladığımızda, Detay sayfasında o borçluya ait hareketleri filtreleyip bize getirebilir mi? (Detay sayfasına gidecek, tıklanan borçlunun adını filtreleyecek). Desteklerinizi bekler, iyi günler dilerim.

Örnek dosya: https://s4.dosya.tc/server9/z0ly2g/ornek.xlsx.html

 

[YUSUF44]

Aşağıdaki kodu Özet sayfasının kod bölümüne yapıştırıp deneyiniz:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [C3:C10000]) Is Nothing Then Exit Sub
Set s1 = Sheets("Detay")
s1.Range("$A$1:$I$" & Rows.Count).AutoFilter Field:=3
son = s1.Cells(Rows.Count, "C").End(3).Row
If Selection.Count > 1 Then Exit Sub
If Target = "" Or Target.Offset(0, -1) = "" Or Target = 0 Then Exit Sub
kod = Target.Offset(0, -1).Value

If WorksheetFunction.CountIf(s1.Range("C1:C10000"), kod) > 0 Then
    s1.Activate
    s1.Range("$A$1:$I$" & son).AutoFilter Field:=3, Criteria1:=kod
End If
End Sub

 

[afk]

Üstad büyüksünüz ! Bilginize, emeğinize sağlık. Çok teşekkür ederim, Allah razı olsun.
Buradan aldığım örnekleri, daha sonra değiştirerek farklı dosyalarda kullanarak, hem kendimi geliştirmeye çalışıyorum, hem de burayı sürekli meşgul etmek istemiyorum. Onun için bir seferde ne kadar çok bilgi edinebilirsem o kadar kar mantığından yola çıkarak, çok zaruri olmamakla birlikte, affınıza sığınarak sizlere bir sualim daha olsa;
Aynı mantıkla, Detay sayfasına "Anasayfa" diye bir hücreye de köprü kursak, o da Özet sayfasına yönlendirse ve Detay sayfasındaki filtreyi kaldırsa (tüm kayıtları listeleyerek bıraksa) mümkün müdür acaba?

 

[YUSUF44]

Aşağıdaki makroyu kullanabilirsiniz:

Sub anasayfa()
Sheets("Detay").Range("$A$1:$I$" & Rows.Count).AutoFilter Field:=3
Sheets("Özet").Activate
ActiveSheet.[A1].Select
End Sub

Bu makroyu çalıştırmak için Detay sayfasına bir düğme ekleyip sağ tıklayın ve makro ata diyerek anasayfa makrosunu seçin.

 

[afk]

Yusuf Üstad, şu mübarek günde gerçekten çok sevaba girdiniz. Allah bilgilerinize zeval vermesin, Allah razı olsun. Hayırlı günler dilerim...

 

[afk]

Aşağıdaki kodu Özet sayfasının kod bölümüne yapıştırıp deneyiniz:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [C3:C10000]) Is Nothing Then Exit Sub
Set s1 = Sheets("Detay")
s1.Range("$A$1:$I$" & Rows.Count).AutoFilter Field:=3
son = s1.Cells(Rows.Count, "C").End(3).Row
If Selection.Count > 1 Then Exit Sub
If Target = "" Or Target.Offset(0, -1) = "" Or Target = 0 Then Exit Sub
kod = Target.Offset(0, -1).Value

If WorksheetFunction.CountIf(s1.Range("C1:C10000"), kod) > 0 Then
    s1.Activate
    s1.Range("$A$1:$I$" & son).AutoFilter Field:=3, Criteria1:=kod
End If
End Sub

Saygıdeğer Üstad, verdiğiniz kodu bir çok dosyama entegre ettim. Ziyadesiyle işimi kolaylaştırdı. Fakat şöyle bir ihtimal acaba mümkün müdür?
Filtre yaptığı sayfada müşteri kodlarına göre filtreleme yapıyor gayet güzel, altına yeni değerler işleyebilme adına filtreye mevcut sayfadaki boş hücreleri de (normal filtrelemede seçilen "Boş Olanlar" değeri gibi) ekleyebilir miyiz? Hayırlı akşamlar.

 

[YUSUF44]

Aşağıdaki gibi dener misiniz?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [C3:C10000]) Is Nothing Then Exit Sub
Set s1 = Sheets("Detay")
s1.Range("$A$1:$I$" & Rows.Count).AutoFilter Field:=3
son = s1.Cells(Rows.Count, "C").End(3).Row
If Selection.Count > 1 Then Exit Sub
If Target = "" Or Target.Offset(0, -1) = "" Or Target = 0 Then Exit Sub
kod = Target.Offset(0, -1).Value

If WorksheetFunction.CountIf(s1.Range("C1:C10000"), kod) > 0 Then
    s1.Activate
    s1.Range("$A$1:$I$" & son).AutoFilter Field:=3, Criteria1:=kod, Operator:=xlOr, Criteria2:="="
End If
End Sub

 

[afk]

Allah razı olsun hocam. Teşekkür ederim.