J ve K da bul ve göster nasıl yaparım.

[subutayı]

örnek dosyada j en büyük k ise n küçük yüzdelik dilimleri gösteriyor. benim yapmak istediğim en küçük ve en büyük vereceğim iki değer arasındaki verileri göstersin. örnek en büyük 5 ile en küçük 15 arasındaki bütün verileri göstersin. excel boyu çok büyük ben bir kısmını örnek olsun diye gönderdim. j1 bir texboox ve k1 de texboox ekleyerek yapabilirsek çok sevinirim. j sütununa küçük rakamı k sütununa da büyük rakamı yazarak ara ve bul yapabileyim.
teşekkürler.

 

[YUSUF44]

Aşağıdaki kodları ilgili sayfanın kod bölümüne yapıştırırsanız J1 ve K1 hücresine yazdığınız sayılara göre anında süzme işlemini yapar. Verilerinizin çokluğuna göre süzme işlemi uzun sürebilir:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [J1:K1]) Is Nothing Then Exit Sub
son = Cells(Rows.Count, "A").End(3).Row
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    ActiveWindow.FreezePanes = True
If Target.Column = 10 Then
    If IsNumeric(Target) = False Then
        MsgBox "Lütfen J1 hücresine en yüksek(üst) yüzdelik dilim olarak sayısal değer giriniz!", vbCritical
        Target.Select
        GoTo 10
    ElseIf Target = "" Then
        ActiveSheet.Range("$A$1:$K$" & son).AutoFilter Field:=10
        [A2].Select
        Target.Select
    Else
        ActiveSheet.Range("$A$1:$K$" & son).AutoFilter Field:=10, Criteria1:=">=" & Target, _
        Operator:=xlAnd
        [K1].Select
    End If
ElseIf Target.Column = 11 Then
    If IsNumeric(Target) = False Then
        MsgBox "Lütfen K1 hücresine en düşük(alt) yüzdelik dilim olarak sayısal değer giriniz!", vbCritical
        Target.Select
        GoTo 10
    ElseIf Target = "" Then
        ActiveSheet.Range("$A$1:$K$" & son).AutoFilter Field:=11
        [A2].Select
        Target.Select
Else
        ActiveSheet.Range("$A$1:$K$" & son).AutoFilter Field:=11, Criteria1:="<=" & Target, _
        Operator:=xlAnd
        [J1].Select
    End If
End If
10:
End Sub

 

[subutayı]

sayın yusuf44,
örnek dosya üzerinde uygulama yapabilirmisiniz. ben sayfanın kod bölümüne yapıştırdım ama nasıl arama yapacağım çözemedim. teşekürler.

 

[Korhan Ayhan]

Merhaba,

Sayfanıza 2 adet TEXTBOX ekleyin.

Sayfanızın kod bölümüne aşağıdaki kodu uygulayın.

Private Sub TextBox1_Change()
    Call Filtre
End Sub

Private Sub TextBox2_Change()
    Call Filtre
End Sub

Boş bir modül ekleyin. Modüle aşağıdaki kodu uygulayın.

Sub Filtre()
    If ActiveSheet.TextBox1 <> "" Then
        ActiveSheet.Range("$A$1:$K$" & Rows.Count).AutoFilter Field:=10, Criteria1:=">=" & ActiveSheet.TextBox1
    Else
        ActiveSheet.Range("$A$1:$K$" & Rows.Count).AutoFilter Field:=10
    End If
    If ActiveSheet.TextBox2 <> "" Then
        ActiveSheet.Range("$A$1:$K$" & Rows.Count).AutoFilter Field:=11, Criteria1:="<=" & ActiveSheet.TextBox2
    Else
        ActiveSheet.Range("$A$1:$K$" & Rows.Count).AutoFilter Field:=11
    End If
End Sub

Dosyanızı kayıt edip kapatıp açın ve denemeler yapın.

 

[subutayı]

teşekürler korhan bey,,
tam istediğim gibi oldu. küçük oğlum teog sınavına girmişti bu onun için.
bir de lys sınavına giren oğlum var onun içinde bir şey rica edebilir miyim.
eklediğim örnek dosyada I sütununda puan türüne göre süzme yapıyorum. örneğim MF-3 göre olan bütün okullar geliyor. K sütunundaki Başarı Sırasında hepsinin görünmesini istemiyorum. sadece 5000 ile 10000 arasındaki okullar karışık sıra da değil, küçükten büyüğe sıralanarak görünsün.Buda çok uzun bir dosya örnek olsun diye bir bölümünü gönderdim. ilgin için teşekkür ederim. kolay gelsin.....

 

[Korhan Ayhan]

Bahsettiğiniz filtre hangi durumda çalışacak?

 

[subutayı]

nasıl hangi durumda anlayamadım korhan bey,
Biz MF-3 tercihi yapacak gibiyiz. ama I sütünundan hangisini tercih edersem ona göre istediğim başarı sıra aralığını göstersin yeter

 

[Korhan Ayhan]

"I" sütununa bir adet daha TEXTBOX ekleyin ve aşağıdaki kodu uygulayın.

Private Sub TextBox3_Change()
    Application.ScreenUpdating = False
    If TextBox3 <> "" Then
        Range("A1").AutoFilter Field:=9, Criteria1:=TextBox3.Text & "*", VisibleDropDown:=False
        Range("A1").AutoFilter Field:=11, Criteria1:=">=5000", Operator:=xlAnd, Criteria2:="<=10000"
        ActiveWorkbook.Worksheets("LİSANS(4 YILLIK)").AutoFilter.Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("LİSANS(4 YILLIK)").AutoFilter.Sort.SortFields.Add _
            Key:=Range("K1"), SortOn:=xlSortOnValues, Order:=xlAscending, _
            DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("LİSANS(4 YILLIK)").AutoFilter.Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    Else
        Range("A1").AutoFilter Field:=9
        Range("A1").AutoFilter Field:=11
    End If
    TextBox3.Activate
    Application.ScreenUpdating = True
End Sub

 

[subutayı]

sayın korhan bey,
çok teşekkür ederim. iyi ki varsınız. Korhan bey, 4 mesajdaki kodlar karışık sıralama yapıyor. küçükten büyüğe doğru sıralaması için kodu nasıl değiştirmemiz gerekir.