3 farlı kritere göre otomatik filtreleme

[ozgurerturk]

Herkese merhaba,

Aşağıdaki tabloda E2, F2 VE G2 hücrelerine yazdığım veriye göre
A4 ile C13 arasındaki verilerin otomatik filtrelenmesi için yazmam gereken kodu bulamadım yardım rica ediyorum.

 

[çıtır]

Sayfa adı Sayfa1 ise değil ise sayfa adını değiştiriniz.

Sub filtre()
Dim s1 As Worksheet
Set s1 = Sheets("Sayfa1")
s1.Select
s1.Range("A4").Select
s1.Range("A4").AutoFilter Field:=1, Criteria1:=s1.Range("E2")
Selection.AutoFilter Field:=2, Criteria1:=s1.Range("F2")
Selection.AutoFilter Field:=3, Criteria1:="=" & s1.Range("G2")
End Sub

 

[ozgurerturk]

Sayfa adı Sayfa1 ise değil ise sayfa adını değiştiriniz.

Sub filtre()
Dim s1 As Worksheet
Set s1 = Sheets("Sayfa1")
s1.Select
s1.Range("A4").Select
s1.Range("A4").AutoFilter Field:=1, Criteria1:=s1.Range("E2")
Selection.AutoFilter Field:=2, Criteria1:=s1.Range("F2")
Selection.AutoFilter Field:=3, Criteria1:="=" & s1.Range("G2")
End Sub

Malesef bu kod çalışmıyor hiçbir filtre çalışmadı, bişeyi yanlış mı yapıyorum acaba?
xlsm uzantılı yeni bir excel açtım, resimde görünen verileri oraya yapıştırdım, sayfa 1 sağ tıklayarak verdiğiniz kodu yapıştırdım
e2 f2 ve g2 hücrelerine girdiğim verilere göre tabloda filtreleme yapmadı

 

[çıtır]

Yeni modül açarak kodu modüle kopyalayınız.Dosyanız.
http://dosya.co/xyrgbp73z2xu/FİLİTRE.rar.html

 

[ozgurerturk]

Dosyanız.
http://dosya.co/xyrgbp73z2xu/FİLİTRE.rar.html

Sizdeki dosyada düğme eklenmiş ben düğme eklenmeden o hücrelere girdiğim veriler otomatik filtrelensin istiyorum.
Aşağıdaki kod ile E2 girdiğim veri otomatik filtreleniyor ancak bu koda F2 ve G2 hücrelerini dahil edemedim.

Private Sub Worksheet_Change(ByVal Target As Range)
'Updateby Extendoffice 20160606
If Target.Address = Range("E2").Address Then
Range("A4:C13").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("E1:E2")
End If
End Sub

Dosyam:
http://dosya.co/62j6zgsepg4j/Yeni_Microsoft_Excel_Çalışma_Sayfası.rar.html

 

[veyselemre]

Sub filtrele()
    Range("A4:C13").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
    Range("E1:G2"), Unique:=False
End Sub
Sub filtreSil()
    Range("A4:C13").AutoFilter
End Sub

 

[çıtır]

Sayfa kodu olarak .Aşağıdaki kodu deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then
        Exit Sub
    End If
If Intersect(Target, [E2,F2,G2]) Is Nothing Then Exit Sub
Range("A4").Select
Range("A4").AutoFilter Field:=1, Criteria1:=Range("E2")
Selection.AutoFilter Field:=2, Criteria1:=Range("F2")
Selection.AutoFilter Field:=3, Criteria1:="=" & Range("G2")
End Sub

 

[ozgurerturk]

Sayfa kodu olarak .Aşağıdaki kodu deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then
        Exit Sub
    End If
If Intersect(Target, [E2,F2,G2]) Is Nothing Then Exit Sub
Range("A4").Select
Range("A4").AutoFilter Field:=1, Criteria1:=Range("E2")
Selection.AutoFilter Field:=2, Criteria1:=Range("F2")
Selection.AutoFilter Field:=3, Criteria1:="=" & Range("G2")


Çok uğraştırdım sizi bu kodda 3 kriter de doğrusa tabloda süzüp çıkartıyor. Benim istediğim E2 girdimde filtrelensin gerek duyarsam f2 girdiğimde tekrar filtrelensin g2 ye girdiğimde tekrar filtrelensin.

Aşağıdaki dosyada ad kısmına tablodan bir isim girerseniz ne demek istediğim daha net anlaşılacak sanırım.
Dosyam:
[URL='http://dosya.co/62j6zgsepg4j/Yeni_Microsoft_Excel_%C3%87al%C4%B1%C5%9Fma_Sayfas%C4%B1.rar.html']http://dosya.co/62j6zgsepg4j/Yeni_Microsoft_Excel_Çalışma_Sayfası.rar.html[/URL]

 

[ozgurerturk]

Sub filtrele()
    Range("A4:C13").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
    Range("E1:G2"), Unique:=False
End Sub
Sub filtreSil()
    Range("A4:C13").AutoFilter
End Sub

Malesef bu kodu çalıştıramadım.

 

[çıtır]

Sayfa kodu olarak aşağıdaki kodu deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then
        Exit Sub
    End If
If Intersect(Target, [E2,F2,G2]) Is Nothing Then Exit Sub
Application.CutCopyMode = False
    Range("A4:C1000").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("E1:G2"), Unique:=False
End Sub

 

[ozgurerturk]

Bu kodu kullandığımda evet istediğim gibi çalışıyor ancak filtrelemek istediğim verileri sildikten sonra tablo eski haline gelmiyor. Filtrelenmiş hücreler gizli kalıyor.

 

[çıtır]

Bu kodu kullandığımda evet istediğim gibi çalışıyor ancak filtrelemek istediğim verileri sildikten sonra tablo eski haline gelmiyor. Filtrelenmiş hücreler gizli kalıyor.

Son satırdan kaynaklandı sildim kodu yeniledim.

 

[ozgurerturk]

Son satırdan kaynaklandı sildim kodu yeniledim.

Çoooooooooooooookkkkkkkk teşekkürler. Bu nasıl bir sabırdır. Harika oldu. Tekrar tekrar teşekkürler harikasınız.

 

[çıtır]

Çoooooooooooooookkkkkkkk teşekkürler. Bu nasıl bir sabırdır. Harika oldu. Tekrar tekrar teşekkürler harikasınız.

Rica ederim.Dönüş yaptığınız için teşekkür ederim.Kolay gelsin.

 

[ozgurerturk]

Çok affedersiniz utanarak yazıyorum ama şimdi de şöyle bir sorun var; filtrelemek istediğim veri alanına (E1, F1, G1) 3 kriteride biyerden kopyala yapıştır yaptığımda filtre çalışmıyor. Evet biliyorum ben tek tek filtreleme yapmak istedim ama zaman zaman buna da ihtiyaç duyuyorum.

 

[çıtır]

E2 hücresine tıklayınız.Yazılı veri sonunda enter tuşlayınız.veya E2,F2,G2 kopyalayınız.

 

[ozgurerturk]

E2 hücresine tıklayınız.Yazılı veri sonunda enter tuşlayınız.veya E2,F2,G2 kopyalayınız.

Malesef e2,f2,g2 ye biyerden kopyala yapıştır yaptığımda filtre çalışmıyor ama yapıştırdığım hücrelerden birini sildiğim zaman filtre çalışıyor


E2,F2,G2 bu üc hücreye yapıştır yapıyorum =filtre çalışmıyor
E2,F2,G2 bu üç hücreye yapıştır yaptıktan sonra G2 siliyorum= filtre çalışıyor

 

[çıtır]

Ya E2,F2,G2 tektek yapıştırınız veya üç hücreyi birden yapıştırdığınız da E2,F2,G2 hücrelerinin birine tıklayınız ve başka hücreye geçiniz.

 

[ozgurerturk]

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [E2,F2,G2]) Is Nothing Then Exit Sub
    Range("A4:C1000").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("E1:G2"), Unique:=False
End Sub

Çok teşekkürler. Artık kopyala yapıştır da çalışıyor tek tek de filtreleniyor. İlginize hayran kaldım "çıtır" ve "veyselemre" sonsuz teşekkürler.

 

[veyselemre]

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [E2,F2,G2]) Is Nothing Then Exit Sub
    Range("A4:C1000").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("E1:G2"), Unique:=False
End Sub