bir kaç filitreye göre değer bulma

[Sezerkaratas]

Bir makro yazmaya çalışıyorum hocam ama çok karışık .
İstiyorum ki sayfa 1 de 1000 den büyük 2000 den küçük Son rakamı 5 olan rakamı bulsun . Örneyin 1005 gibi ve sayfa 2 a 2 ye yazsın mümkün müdür

 

[Muzaffer Ali]

Merhaba.

Aşağıdaki kod ile yapılabilir.
Ancak arama kriterlerine göre birden fazla sonuç olsa bile sadece ilk sonucu Sayfa2 A2 ye yazar.

Sub Ara()
    Dim Bak As Range
    For Each Bak In Worksheets("Sayfa1").Range("A:A") 'Sayfa1'in A kolonunun tamamında arama yapar
        If Bak.Text > 1000 And Bak < 2000 And Right(Bak, 1) = 5 Then
            Worksheets("Sayfa2").Range("A2") = Bak.Text
            MsgBox "Arama tamamlandı. Bulunan rakam: " & Bak.Text
            Exit Sub
        End If
    Next
    MsgBox "Arama tamamlandı ancak aranan veri bulunamadı."
End Sub

 

[YUSUF44]

Aşağıdaki makroyu deneyiniz. Belirttiğiniz şartlara uyan ilk sayıyı yazar:

Sub saybul()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
son = s1.Cells(Rows.Count, "A").End(3).Row
For i = 1 To son
    If s1.Cells(i, "A") > 1000 And s1.Cells(i, "A") < 2000 And Right(s1.Cells(i, "A"), 1) = 5 Then
        s2.[A2] = s1.Cells(i, "A")
        Exit Sub
    Else
        s2.[A2] = ""
    End If
Next
End Sub

 

[Sezerkaratas]

Merhaba.

Aşağıdaki kod ile yapılabilir.
Ancak arama kriterlerine göre birden fazla sonuç olsa bile sadece ilk sonucu Sayfa2 A2 ye yazar.

Sub Ara()
    Dim Bak As Range
    For Each Bak In Worksheets("Sayfa1").Range("A:A") 'Sayfa1'in A kolonunun tamamında arama yapar
        If Bak.Text > 1000 And Bak < 2000 And Right(Bak, 1) = 5 Then
            Worksheets("Sayfa2").Range("A2") = Bak.Text
            MsgBox "Arama tamamlandı. Bulunan rakam: " & Bak.Text
            Exit Sub
        End If
    Next
    MsgBox "Arama tamamlandı ancak aranan veri bulunamadı."
End Sub

Hocam şimdi şöyle 1005 var diyelim bide 1015 var diyelim 1015 i yazar değil mi

 

[YUSUF44]

Yukardan aşağı doğru bakar, şartlara uyan ilk hücredeki veriyi yazar. Başka bir şart istiyorsanız şart(lar)ın ne olduğunu açıkça belirtmeniz gerekir.

 

[Muzaffer Ali]

Şartlara uyanları A2 den itibaren listelemek için aşağıdaki kodu kullanabilirsiniz.

Sub Ara()
    Dim Bak As Range
    Worksheets("Sayfa2").Range("A:A").ClearContents
    For Each Bak In Worksheets("Sayfa1").Range("A1:A" & Worksheets("Sayfa1").Cells(Rows.Count, "A").End(3).Row)
        If Bak.Text > 1000 And Bak < 2000 And Right(Bak, 1) = 5 Then
            With Worksheets("Sayfa2")
                .Range("A" & .Cells(Rows.Count, "A").End(3).Row + 1) = Bak.Text
            End With
        End If
    Next
    MsgBox "İşlem tammalandı."
End Sub

 

[Korhan Ayhan]

Alternatif;

Sub Test()
    Sheets("Sayfa2").Range("A2") = Evaluate("=LARGE(((Sayfa1!A1:A10000>1000)*(Sayfa1!A1:A10000<2000)*(RIGHT(Sayfa1!A1:A10000,1)=""5"")*(Sayfa1!A1:A10000)),1)")
End Sub