Excel'de Tek Tıkla Otomatik Tablo Filtrelemek

[Utekiner]

Merhaba,

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

kolon= Target.Column
kriter=Target.Value
ıf Target.Row=1 Then
Else
ActiveSheet.ListObjects("Tablo1").Range.AutoFilter Field:=kolon, Criteria:=kriter, Operator:=XlAnd
End If

End Sub

Makro kaydet ile temin edilen kodlarda bir geliştirme konusunda destek olabilir misiniz. Tablo1 harici sütununa tıkladığımda sürekli hata veriyor. Hata vermemesi için kodda nasıl bir ekleme yapılmalıdır.

 

[ÖmerFaruk]

Aşağıdaki şekilde deneyin.
Tablonun başlık satırına tıklayınca Filtre resetleniyor.
Sayfanın başka yerinde tıklandığında çalışmasını da engellemek lazım.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

kolon = Target.Column
kriter = Target.Value
If Target.Row > 1 Then
    Worksheets("Sayfa1").ListObjects("Tablo1").Range.AutoFilter _
    Field:=kolon, Criteria1:="=" & kriter
Else
    If Worksheets("Sayfa1").ListObjects("Tablo1").AutoFilter.FilterMode Then _
    Worksheets("Sayfa1").ListObjects("Tablo1").AutoFilter.ShowAllData
End If
End Sub

 

[Utekiner]

Aşağıdaki şekilde deneyin.
Tablonun başlık satırına tıklayınca Filtre resetleniyor.
Sayfanın başka yerinde tıklandığında çalışmasını da engellemek lazım.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

kolon = Target.Column
kriter = Target.Value
If Target.Row > 1 Then
    Worksheets("Sayfa1").ListObjects("Tablo1").Range.AutoFilter _
    Field:=kolon, Criteria1:="=" & kriter
Else
    If Worksheets("Sayfa1").ListObjects("Tablo1").AutoFilter.FilterMode Then _
    Worksheets("Sayfa1").ListObjects("Tablo1").AutoFilter.ShowAllData
End If
End Sub

Ömer Bey teşekkür ederim.
A ile E sütunun arasında kritere göre filtreleme yapıyorum. Başlığa tıklayınca filtre resetleniyor. Ama F- G gibi herhangi bir sütuna tıklayınca resimdeki hatayı veriyor. Bunu nasıl geçebilirim. tablosuz bir yere başlık harici tıkladığımda bir işlem yapmasın.

 

[Utekiner]

Tamda sizin bahsettiğiniz " Sayfanın başka yerinde tıklandığında çalışmasını da engellemek lazım. " yapmasını istiyorum.

 

[ÖmerFaruk]

Tablonuzun aralığı neresi?

 

[Utekiner]

sürekli değişiyor. ben bu makroyu farklı bir çok kitapta kullanacağım. Burda örneğin. A ile D arası siz gösterirseniz ben ona göre diğer dosyalarda uygulama yapabilirim.

 

[Haluk]

Şöyle olabilir;

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim myTable As ListObject
    
    Set myTable = Worksheets("Sayfa1").ListObjects("Tablo1")
    kolon = Target.Column
    kriter = Target.Value

    If Not Intersect(Target, myTable.DataBodyRange) Is Nothing Then
        myTable.Range.AutoFilter Field:=kolon, Criteria1:="=" & kriter
    ElseIf Not Intersect(Target, myTable.HeaderRowRange) Is Nothing Then
        If myTable.AutoFilter.FilterMode Then myTable.AutoFilter.ShowAllData
    End If
End Sub

.

 

[Utekiner]

@Haluk Bey hızır gibisin. Eline koluna sağlık.

 

[ÖmerFaruk]

Haluk bey de cevaplamış. Tablo ortada olursa fark edermi bilmiyorum. Elinizde bulunsuz.
Tablo mesela B410 aralığında ise aşağıdaki kodlar hata vermeyecektir.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Worksheets("Sayfa1").ListObjects("Tablo1").DataBodyRange) Is Nothing Then
kolon = Target.Column - Worksheets("Sayfa1").ListObjects("Tablo1").DataBodyRange.Cells(1, 1).Column + 1
kriter = Target.Value
Worksheets("Sayfa1").ListObjects("Tablo1").Range.AutoFilter Field:=kolon, Criteria1:="=" & kriter
Else
    If Worksheets("Sayfa1").ListObjects("Tablo1").AutoFilter.FilterMode Then _
    Worksheets("Sayfa1").ListObjects("Tablo1").AutoFilter.ShowAllData
End If
End Sub

 

[Utekiner]

@ÖmerFaruk Bey teşekkür ederim. İlginiz ve vakit ayırdığınız için.