filitreleme hatası

[mukerrer05]

merhaba arkadaşlar

listbox dan seçtiğim verilerin alt alta olan iki özet tabloda filitrelenmesini istiyorum.kod aşağıdaki gibidir ancak "d3" ile yazan yerde filitreleme yapmıyor.

For Each hucre In Sheets("MALİYET").Range("B11:B" & WorksheetFunction.CountA(Sheets("MALİYET").Range("B11:B65000")) + 1)
If StrConv(hucre.Value, vbUpperCase) = StrConv(Range("D2").Value, vbUpperCase) Then
hucre.Select

Selection.AutoFilter Field:=2
Selection.AutoFilter Field:=2, Criteria1:=Sheets("MALİYET").Range("A8").Value
End If
Next

For Each hucre In Sheets("MALİYET").Range("B11:B" & WorksheetFunction.CountA(Sheets("MALİYET").Range("B11:B65000")) + 1)
If StrConv(hucre.Value, vbUpperCase) = StrConv(Range("D3").Value, vbUpperCase) Then
hucre.Select

Selection.AutoFilter Field:=2
Selection.AutoFilter Field:=2, Criteria1:=Sheets("MALİYET").Range("A8").Value
End If
Next


yardımlarınız için şimdiden teşekkürler

 

[Korhan Ayhan]

Merhaba,

Forumumuza hoşgeldiniz. Aynı veri üzerine farklı iki filtre uygulamak istiyorsanız bunu yapamazsınız. Fakat örnek dosya ekleyerek ne yapmak istediğinizi açıklarsanız alternatif çözümler üretebiliriz.

 

[mukerrer05]

korhan hocam

dosya ektedir

 

[Korhan Ayhan]

Merhaba,

Aynı veri üzerinde iki farklı alana filtre uygulayamazsınız. İstediğiniz işlemi makro ile yapabilirsiniz. Veriler döngüye alınır ve kritere uymayan satırlar gizlenerek istediğiniz görüntüyü elde edebilirsiniz. İsterseniz bu yönde kod için yardımcı olabilirim.

 

[mukerrer05]

tekrar merhaba hocam,


eğer bu şekilde olmuyorsa, makro ile yardımcı olursanız sevinirim

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu sayfanızın kod bölümüne uygulayın. A1 hücresine süzmek istediğiniz değeri yazıp enter tuşuna bastığınızda kod çalışacaktır.

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim X As Long
    If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Cells.EntireRow.Hidden = False
    If Target <> "" Then
        For X = 2 To Cells(Rows.Count, 1).End(3).Row
            If Cells(X, 1) <> "FİRMA" And Cells(X, 2) <> Target Then
                Cells(X, 1).EntireRow.Hidden = True
            End If
        Next
    End If
    Application.ScreenUpdating = True
End Sub