Soru belli tutarları filtreleme

[NADİR YILDIZ]

Arkadaşlar merhaba
örnek dosyamda -10 dan küçük ve + 10 büyük olanları filtrelemek istiyorum
makro ile nasıl yapabilirim
teşekkürler

 

[AdemCan]

Merhaba örnek kod.
Belirtilen sütun harfi ( Q - S arası ) ve kritere göre filtreleme işlemi yapar.

Sub test()
Application.ScreenUpdating = False
Dim s1 As Worksheet, son As Long, sutun As String, kriter As String, buyuk_kucuk As String
On Error Resume Next
Set s1 = Sayfa1
son = s1.Range("Q" & Rows.Count).End(3).Row
sutun = UCase(Application.InputBox("Sütun Harfini Yazınız!", "Filtre için Sütun Belirleme"))
kriter = Application.InputBox("-10 ya da +10 şeklinde kriter belirtin!", "Filtre için Kriter Belirleme")

If sutun = "False" Or kriter = "False" Then
    MsgBox "Sütun ya da Kriter belirleme yapmadınız!", vbExclamation, ""
    Exit Sub
End If

s1.ShowAllData
    With s1.Range("Q5:S" & son)
        If sutun = "Q" Then
            sutun = 1
        ElseIf sutun = "R" Then
            sutun = 2
        ElseIf sutun = "S" Then
            sutun = 3
        Else
            MsgBox "Geçerli sütun harfi yazmadınız!", vbExclamation, ""
            Exit Sub
        End If
        If Left(kriter, 1) = "-" Then
            buyuk_kucuk = "<"
        Else
            buyuk_kucuk = ">"
        End If
        .AutoFilter Field:=sutun, Criteria1:=buyuk_kucuk & kriter
    End With
Application.ScreenUpdating = True

 

[NADİR YILDIZ]

Adem bey öncelikle teşekkürler

mavi olarak işaretlediğim R sütunundakileri filtrelemek istiyorum
tutar girmeden -10 dan küçük ve + 10 dan büyük olanları filtrelemesini istiyorum

 

[AdemCan]

Sadece R sütununda 10 dan büyük ve -10 dan küçük değerleri filtreler.

Sub test2()
Application.ScreenUpdating = False
Dim s1 As Worksheet, son As Long
On Error Resume Next
Set s1 = Sayfa1
son = s1.Range("Q" & Rows.Count).End(3).Row

s1.ShowAllData
    With s1.Range("Q5:S" & son)
        .AutoFilter Field:=2, Criteria1:=">10", Operator:=xlOr, Criteria2:="<-10"
    End With
    
Application.ScreenUpdating = True
End Sub

 

[NADİR YILDIZ]

Adem teşekkürler
iyi çalışmalar

 

[AdemCan]

İyi çalışmalar.

 

[NADİR YILDIZ]

Adem bey
verdiğiniz kodları orjinal dosyama uyguladığımda sonuç alamadım
sorun nereden kaynaklı olabilir

 

[AdemCan]

Q - R - S sütunlarına da filtre ekleyip kodları değiştiriniz.

Private Sub CommandButton4_Click()
Application.ScreenUpdating = False
Dim s1 As Worksheet, son As Long
On Error Resume Next
Set s1 = Sayfa5

s1.ShowAllData
son = s1.Range("Q" & Rows.Count).End(3).Row
    With s1.Range("A5:S" & son)
        .AutoFilter Field:=18, Criteria1:=">10", Operator:=xlOr, Criteria2:="<-10"
    End With
    
Application.ScreenUpdating = True
End Sub

 

[NADİR YILDIZ]

Teşekkürler Adem bey

 

[AdemCan]

Rica ederim.