Tablo Filtreleme Formülü

[akasay]

Arkadaşlar A - B - C sütunlarından oluşan bir tabloda Örneğin A sütunu AY B sütunu ÖDENECEK MİKTAR, C sütunu ÖDEME DURUMU şeklinde başlıklar var.

A sütununda Ocak, Şubat, Mart vb. B sütununda 10, 20, 50... ve C sütununda ise Ödendi-Ödenmedi gibi veriler var.

Yazılacak bir formül ya da kod ile örneğin D1'e "ÖDENENLERİ FİLTRELE" yazısına tıklayınca otomatik olarak tabloyu filtreleyecek bir kod ya da formül arıyorum. Yardımlarınız için şimdiden teşekkür ederim.

 

[akasay]

Buraya örnek dosyayı attım. İçerisinde "açıklama" var.
http://www.dosya.tc/server2/u6ud0g/filtre.xlsx.html

 

[acar6783]

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D1]) Is Nothing Then Exit Sub
Rows.EntireRow.Hidden = 0
For i = 2 To Cells(Rows.Count, "A").End(3).Row
If Cells(i, "C") <> Range("D1") Then

Rows(i).EntireRow.Hidden = 1
End If
Next
End Sub

Sayfanın odları bu şekilde olacak.
Sayfanın görünümü bahsettiğini şekilde
D1 hücresine ise veri doğrulama yöntemi ile sırasıyla;
Veri doğrulama-doğrulama ölçütü-izin verilen-Liste- kaynak : " ödendi;ödenmedi"

şeklinde yaparsanız siz her d1 deki veriyi değiştirdiğinizde değişikliği göreceksiniz

 

[skaan]

Merhaba;
Farklı bir yöntemle..
Tablo içinde filtrelemek istediğiniz verinin üstüne tıklayınca o hücredeki veriye göre hücreye göre süzer.Tablo dışında her hangi bir hücreye tıklatınca, tüm verileri gösterir.

Kolay Gelsin
SKaan

 

[akasay]

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D1]) Is Nothing Then Exit Sub
Rows.EntireRow.Hidden = 0
For i = 2 To Cells(Rows.Count, "A").End(3).Row
If Cells(i, "C") <> Range("D1") Then

Rows(i).EntireRow.Hidden = 1
End If
Next
End Sub

Sayfanın odları bu şekilde olacak.
Sayfanın görünümü bahsettiğini şekilde
D1 hücresine ise veri doğrulama yöntemi ile sırasıyla;
Veri doğrulama-doğrulama ölçütü-izin verilen-Liste- kaynak : " ödendi;ödenmedi"

şeklinde yaparsanız siz her d1 deki veriyi değiştirdiğinizde değişikliği göreceksiniz

Üstad örnek dosya yükleyebilir misiniz dosya sitelerinden birine tam gerçekleştireemedim dediğinizi :/

 

[akasay]

Kodaları denedim çalışıyor fakat sayfa korumalı durumda korumalı durumdayken kodlar çalışmıyor nasıl düzeltmeliyiz kodları

Merhaba;
Farklı bir yöntemle..
Tablo içinde filtrelemek istediğiniz verinin üstüne tıklayınca o hücredeki veriye göre hücreye göre süzer.Tablo dışında her hangi bir hücreye tıklatınca, tüm verileri gösterir.

Kolay Gelsin
SKaan

 

[akasay]

sayfa korumalı durumda korumalı durumdayken kodlar çalışmıyor skaan'ın verdiği kodları düzenleyecek birisi var mı acaba :/

 

[Erdem Akdemir]

Merhaba,

Sayfa korumayı tekrardan ayarlayın,otomatik filtre kullan seçeneğini işaretleyin. Koduda çift tıklama ile çalışır hale getirin, daha verimli olacaktır.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.ScreenUpdating = False
    
    Dim hcr As Range
    Dim Thcr As Boolean
    Dim sut As Single

On Error Resume Next
    Set hcr = Selection
    Thcr = (hcr.ListObject.Name <> "")
   
On Error GoTo 0
    
    If Thcr = False Then
        For i = 1 To ActiveSheet.ListObjects.Count
        For j = 1 To ActiveSheet.ListObjects(i).Range.Columns.Count
                ActiveSheet.ListObjects(i).Range.AutoFilter Field:=j
        Next j
        Next i
        Exit Sub
    End If
    
    If Selection.Cells.Count > 1 Then Exit Sub
    sut = Selection.Column - hcr.ListObject.Range.Column + 1
    
    ActiveSheet.ListObjects(hcr.ListObject.Name).Range.AutoFilter _
    Field:=sut, Criteria1:="=" & Selection

Application.ScreenUpdating = True

Cancel = True
    
End Sub

 

[akasay]

Merhaba,

Sayfa korumayı tekrardan ayarlayın,otomatik filtre kullan seçeneğini işaretleyin. Koduda çift tıklama ile çalışır hale getirin, daha verimli olacaktır.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.ScreenUpdating = False
    
    Dim hcr As Range
    Dim Thcr As Boolean
    Dim sut As Single

On Error Resume Next
    Set hcr = Selection
    Thcr = (hcr.ListObject.Name <> "")
   
On Error GoTo 0
    
    If Thcr = False Then
        For i = 1 To ActiveSheet.ListObjects.Count
        For j = 1 To ActiveSheet.ListObjects(i).Range.Columns.Count
                ActiveSheet.ListObjects(i).Range.AutoFilter Field:=j
        Next j
        Next i
        Exit Sub
    End If
    
    If Selection.Cells.Count > 1 Then Exit Sub
    sut = Selection.Column - hcr.ListObject.Range.Column + 1
    
    ActiveSheet.ListObjects(hcr.ListObject.Name).Range.AutoFilter _
    Field:=sut, Criteria1:="=" & Selection

Application.ScreenUpdating = True

Cancel = True
    
End Sub

Çok teşekkür ederim. Bir de örnek dosya olsa sanırım daha net düzenleyebileeğim.