Filitre (Küçük-Büyük-Arasında)

[vivident]

Merhaba

Ekteki dosyada ;

C4 - E4 - G4 - I4 hücrelerine değer girilip, filitre kutucuğuna tıklandığında, girilen değerlere göre filitreleme yapıyor. Ayrıca ben "<" veya ">" ifadelerini kullanarak da filitreleme yaptırabiliyorum.

Örneğin ; E4 Hücresine <3 girilirse 3'den küçük değerleri filitreliyor. Benim istediğim 1<4 yazdığımda normal şartlarda 2 ile 3 değerlerini filitreleme yapması gerekiyor, ama filitrelemiyor

Yani x<y
X değerinden büyük Y değerinden küçük değerleri filitreleme yaptıramıyorum. Dosyam ektedir

 

[Korhan Ayhan]

Merhaba,

Aralıklı değer filtrelemek için iki hücre kullanmanız gerekmez mi?

 

[vivident]

Korhan bey ikinci bir hücre daha tanımladım G5 hücresi
Ama çalıştırmadım. Yardımcı olursanız memnun olurum
Dosyam ektedir

Set s1 = ThisWorkbook.Worksheets("ANA SAYFA")
For Each i In Worksheets
If IsNumeric(i.Name) Then
Set s2 = i
    s2.Select
    If s1.Cells(4, 7) <> "" Then Selection.AutoFilter Field:=3, Criteria1:=s1.Cells(4, 7)
    If s1.Cells(4, 7) = "" Then Selection.AutoFilter Field:=3
    If s1.Cells(5, 7) <> "" Then Selection.AutoFilter Field:=4, Criteria1:=s1.Cells(5, 7)
    If s1.Cells(5, 7) = "" Then Selection.AutoFilter Field:=4
    End If

 

[vivident]

Konu günceldir

 

[Korhan Ayhan]

Aşağıdaki kodları kullanabilirsiniz.

Sub Filtreleri_Kaldır()
    Dim Sayfa As Worksheet
    On Error Resume Next
    Application.ScreenUpdating = False
    For Each Sayfa In ThisWorkbook.Worksheets
        If Sayfa.AutoFilterMode Then Sayfa.ShowAllData
    Next
    Application.ScreenUpdating = True
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Sub Filtre_Uygula()
    Dim Sayfa As Worksheet, S1 As Worksheet
    Set S1 = Sheets("ANA SAYFA")
    On Error Resume Next
    Application.ScreenUpdating = False
    For Each Sayfa In ThisWorkbook.Worksheets
        If Sayfa.Name <> "ANA SAYFA" Then
            If S1.Range("C4") <> "" Then Sayfa.Range("B49").AutoFilter 1, S1.Range("C4")
            If S1.Range("E4") <> "" Then Sayfa.Range("B49").AutoFilter 2, S1.Range("E4")
            If S1.Range("G4") <> "" Then Sayfa.Range("B49").AutoFilter 3, S1.Range("G4")
            If S1.Range("G5") <> "" Then Sayfa.Range("B49").AutoFilter 3, S1.Range("G4"), xlAnd, S1.Range("G5")
            If S1.Range("I4") <> "" Then Sayfa.Range("B49").AutoFilter 4, S1.Range("I4")
        End If
    Next
    Application.ScreenUpdating = True
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[vivident]

Teşekkür ederim Korhan bey
İyi çalışmalar