4 kritere göre filtreleme

[mehmetkoca]

Değerli Arkadaşlar;
Ekte bulunan dosyada a1,b1,c1,d1 hücrelerine girdiğim değerlere göre listede filtreleme yapmak istiyorum.Yani a1=198 b1=72,5 c1=vda 21 d1=maun yazdığımda bu dört hücrede belirtilen değere göre filtreleme sonucu olacak.

Saygılarımla.

 

[Murat OSMA]

Module1'e;

Sub MehmetKoca()
    ActiveSheet.Range("$A$2:$D$1526").AutoFilter Field:=1, Criteria1:=[a1]
    ActiveSheet.Range("$A$2:$D$1526").AutoFilter Field:=2, Criteria1:=[b1]
    ActiveSheet.Range("$A$2:$D$1526").AutoFilter Field:=3, Criteria1:=[c1]
    ActiveSheet.Range("$A$2:$D$1526").AutoFilter Field:=4, Criteria1:=[d1]
End Sub

Veri Sayfasına;

Private Sub Worksheet_Change(ByVal Target As Range)
 Range("A2").Select
 Selection.AutoFilter
End Sub

 

[Husgvarna]

Değerli Arkadaşlar;
Ekte bulunan dosyada a1,b1,c1,d1 hücrelerine girdiğim değerlere göre listede filtreleme yapmak istiyorum.Yani a1=198 b1=72,5 c1=vda 21 d1=maun yazdığımda bu dört hücrede belirtilen değere göre filtreleme sonucu olacak.

Saygılarımla.

Merhaba.
Şöylede deneyebilirsiniz.

 Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [a1:d1]) Is Nothing Then
a = Target.Column: b = Target.Row
Range(Cells(b + 1, a), Cells(Cells(65000, 1).End(xlUp).Row, a)).AutoFilter Field:=a, Criteria1:=Target
    ActiveWindow.SmallScroll Down:=54
    If Target = "" Then _
    Range(Cells(b + 1, a), Cells(Cells(65000, 1).End(xlUp).Row, a)).AutoFilter Field:=a
    Target.Select
    End If
End Sub

 

[mehmetkoca]

Hocam teşekkürler elinize sağlık.Çok hızlı bir şekilde cevapladınız.Eğer zahmet olmayacaksa filtreleme sonucu çıkan verileri 2.sayfaya aktarma kodunuda yazabilirmisiniz.

Saygılarımla

 

[Husgvarna]

Eklediğim kodları kullanıyorsanız:
Her süzüleni alt alta 2.sayfaya eklemek için; ("D1" e veri girildiğinde)

 Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [a1:d1]) Is Nothing Then
a = Target.Column: b = Target.Row
Range(Cells(b + 1, a), Cells(Cells(65000, 1).End(xlUp).Row, a)).AutoFilter Field:=a, Criteria1:=Target
    ActiveWindow.SmallScroll Down:=54
    If Target = "" Then _
    Range(Cells(b + 1, a), Cells(Cells(65000, 1).End(xlUp).Row, a)).AutoFilter Field:=a
   Cells(Target.Row, Target.Column + 1).Select
    If Not Intersect(Target, Range("d1")) Is Nothing Then
Range("A3:D" & Cells(65000, 1).End(xlUp).Row).Copy Sheets("Sayfa2").Range("A" & Sheets("Sayfa2").Cells(65000, 1).End(xlUp).Row + 1)
Application.CutCopyMode = False
End If
    End If
End Sub

Öncekiler kaldırılarak:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [a1:d1]) Is Nothing Then
a = Target.Column: b = Target.Row
Range(Cells(b + 1, a), Cells(Cells(65000, 1).End(xlUp).Row, a)).AutoFilter Field:=a, Criteria1:=Target
    ActiveWindow.SmallScroll Down:=54
    If Target = "" Then _
    Range(Cells(b + 1, a), Cells(Cells(65000, 1).End(xlUp).Row, a)).AutoFilter Field:=a
    Cells(Target.Row, Target.Column + 1).Select
    Sheets("Sayfa2").[a1:d65000] = Empty
    Range("A1").CurrentRegion.Copy Sheets("Sayfa2").Range("A1")
    End If
End Sub