Anahtar Kelime Arama Makrosu

[sleeper]

Sorum basit aslında ama forumda da aratmama rağmen bir türlü işin içinden çıkamadım.

A1 hücresine yazmış olduğum kelimeyi B sütununda aratmak. Yalnız birebir değer araması değil.

Misal; A1 hücresine "Ali" yazdığımda B sütunundaki bütün "Ali" ismindekileri sarı renge boyayan bir makro yazmaya çalıştım ama beceremedim. Birebir değerleri buluyor sadece.

 

[Erdem Akdemir]

Merhaba,

Tag'daki formülü kullanabilirsiniz.

 

[sleeper]

Cahilliğimi mazur görün ama Tag derken? :dusun:

 

[sleeper]

Yardımlarınız için öncelikle teşekkür ederim.

Aslında ben bu sorunuma benzer ama biraz daha komplike bir konuda yardımlarınızı rica edeceğim.

Yapmak istediğim;

Bir hücreye (Kayıt Bul sayfasındaki H3 hücresi) Konu adı yazıyorum (misal "Ali"). Kayıt Bul sayfasında oluşturduğum Ara butonuna bastığımda aynı konudan birden fazla var ise bir userform açılıyor ve içerisinde o konu adına ait bilgilerin olduğu listview de veriler çıkıyor. Aşağıda paylaştığım kodlarla bunu sorunsuz gerçekleştiriyorum. Ama tam istediğim gibi değil maalesef.

Sizlerden yardımını istediğim mevzular;

1- Ben arattığımda sadece "Ali" kelimesi geçen hücreleri buluyor, ben "Ali" kelimesi geçen bütün satırları bulup verisini listviewde göstersin istiyorum. (Misal "Ali diye arattığımda "Aliye" yi bulamıyor.

2- Ayrıca küçük büyük harf duyarlı yapamadım. "Ali diye kayıtlıysa "ALİ" diye arattığımda yine sonuç vermiyor.


Kullanmış olduğum kodlar;

Commandbutton Kodu:

say = WorksheetFunction.CountIf(vtab.Range("F:F"), kbul.Range("H3").Value)

If say > 1 Then
UserForm2.Show
End If

Userform Kodu:

Dim s5 As Worksheet
Set s5 = Sheets("Veritabani")
s5.Activate
    With ListView1
        .ListItems.Clear
        
        For j1 = 2 To s5.Range("F1048576").End(xlUp).Row
            If (s5.Cells(j1, "F")) = (kbul.Range("H3").Value) Then
                
                .ListItems.Add , , s5.Cells(j1, "A").Value
                .ListItems(.ListItems.Count).ListSubItems.Add , , s5.Cells(j1, "C").Value
                .ListItems(.ListItems.Count).ListSubItems.Add , , s5.Cells(j1, "d").Value
                .ListItems(.ListItems.Count).ListSubItems.Add , , s5.Cells(j1, "e").Value
                .ListItems(.ListItems.Count).ListSubItems.Add , , s5.Cells(j1, "m").Value
                .ListItems(.ListItems.Count).ListSubItems.Add , , s5.Cells(j1, "ı").Value
                .ListItems(.ListItems.Count).ListSubItems.Add , , s5.Cells(j1, "j").Value
                .ListItems(.ListItems.Count).ListSubItems.Add , , s5.Cells(j1, "k").Value
                .ListItems(.ListItems.Count).ListSubItems.Add , , s5.Cells(j1, "S").Value
                .ListItems(.ListItems.Count).ListSubItems.Add , , s5.Cells(j1, "V").Value

            End If
        Next j1
        
    End With

 

[Orion1]

o kodların yerine aşağıdakileri kullanarak deneyiniz.

Dim k As Range, adr As String
Dim s5 As Worksheet
Set s5 = Sheets("Veritabani")
s5.Activate
With ListView1
    .ListItems.Clear
    Set k = s5.Range("F2:F" & Rows.Count).Find(kbul.Range("H3").Value & "*", , xlValues, xlWhole)
    If Not k Is Nothing Then
        adr = k.Address
        Do
            .ListItems.Add , , s5.Cells(k.Row, "A").Value
            .ListItems(.ListItems.Count).ListSubItems.Add , , s5.Cells(k.Row, "C").Value
            .ListItems(.ListItems.Count).ListSubItems.Add , , s5.Cells(k.Row, "d").Value
            .ListItems(.ListItems.Count).ListSubItems.Add , , s5.Cells(k.Row, "e").Value
            .ListItems(.ListItems.Count).ListSubItems.Add , , s5.Cells(k.Row, "m").Value
            .ListItems(.ListItems.Count).ListSubItems.Add , , s5.Cells(k.Row, "ı").Value
            .ListItems(.ListItems.Count).ListSubItems.Add , , s5.Cells(k.Row, "j").Value
            .ListItems(.ListItems.Count).ListSubItems.Add , , s5.Cells(k.Row, "k").Value
            .ListItems(.ListItems.Count).ListSubItems.Add , , s5.Cells(k.Row, "S").Value
            .ListItems(.ListItems.Count).ListSubItems.Add , , s5.Cells(k.Row, "V").Value
            Set k = s5.Range("F2:F" & Rows.Count).FindNext(k)
        Loop While Not k Is Nothing And k.Address <> adr
    End If
End With

 

[sleeper]

@Orion1 çok teşekkür ederim. Sizin kodunuz da bir tek xlWhole yerine xlPart yaptım. Tam istediğim gibi oldu. k::

Dim k As Range, adr As String
Set k = s5.Range("F2:F" & Rows.Count).Find(kbul.Range("H3").Value & "*", , xlValues, xlPart)