Arama Yazdırma Anahtar Kelime

[walabi]

Merhaba,

Ekli dosyada şöylesi birşey yapmaya çalışıyorum.

Ekli dosyadaki veriler bir listeden alınmakta. Sütun sayıları sabit ancak satırları sürekli artan bir stok listenin ufak bir örneği. Amacım ise şu. Liste adlı excel sayfasının L sütununa veri yazdırmam gerekli.

Bunu ise şu şekilde yapmalıyım. Liste adlı sayfanın B sütununda bazı anahtar kelimeler aratacağım. Eğer B sütununda , ilgili satırda bu kelime varsa aynı satırın L sütunu hücresine ilgili anahtar kelimeyi yazdırmam gerekli. Eğer aranan kelimelerden hiçbiri yok ise ilgili L sütunu hücresi boş olacak.

Ekli dosyada yatayara ile kısmi bir çözüm bulabiliyorum. Ancak aranacak anahtar kelime sayısı fazla olduğu için içiiçe çok fazla formül kullanmam gerekli gibi. Bunu makro ile nasıl yapabilirim.

Bunu yapmaya çalışmamdaki amaç ise şu. B sütunu Kırtasiye ürünlerinin isimlerini ( ürün tanımı ) içermekte. Bunlardan bazıları kitap yayın evlerinin adlarını içermekte. Bundan dolayı bu yayın evlerinin adlarını kısa tanımlar halinde L sütununa çekmeye çalışıyorum.

Acaba pratik bir makro çözümü olabilir mi.

Aklıma gelen şu. Ekli dosyada Aranacak adlı excel sayfasının A sütununa ilgili anahtar kelimeleri girip , Liste adlı excel sayfasının B sütununda aratmak, aranan varsa, L sütununa yazdırmak, yok ise boş geçmek. Sayfa altına kodlanabilir sanırım. Ya da daha uygun pratik bir çözüm nasıl olabilir.

 

[Muzaffer Ali]

Merhaba.

Aşağıdaki kodları bir module kopyalayarak çalıştırın.

Sub Test()
    Dim BakAra As Integer
    Dim Say As Integer
    With Worksheets("Aranacak")
        For BakAra = 1 To .Cells(Rows.Count, "A").End(xlUp).Row
            Worksheets("Liste").Range("A:L").AutoFilter Field:=2, Criteria1:="*" & .Cells(BakAra, "A") & "*" ', Operator:=xlFilterValues
            Say = Worksheets("Liste").Cells(Rows.Count, "A").End(xlUp).Row
            If Say > 1 Then Worksheets("Liste").Range("L2:L" & Say) = .Cells(BakAra, "A")
        Next
    End With
    Worksheets("Liste").ShowAllData
End Sub

 

[walabi]

Merhaba.

Aşağıdaki kodları bir module kopyalayarak çalıştırın.

Sub Test()
    Dim BakAra As Integer
    Dim Say As Integer
    With Worksheets("Aranacak")
        For BakAra = 1 To .Cells(Rows.Count, "A").End(xlUp).Row
            Range("A:L").AutoFilter Field:=2, Criteria1:="*" & .Cells(BakAra, "A") & "*" ', Operator:=xlFilterValues
            Say = Cells(Rows.Count, "A").End(xlUp).Row
            If Say > 1 Then Range("L2:L" & Say) = .Cells(BakAra, "A")
        Next
    End With
    ShowAllData
End Sub

Merhaba,

Bir modül ekleyerek çalıştırdım ancak şu uyarıyı almaktayım. "Sub or Function not defined".

 

[Muzaffer Ali]

Kodu düzelttim yeniden deneyin.

 

[walabi]

Kodu düzelttim yeniden deneyin.

Muzaffer Ali bey teşekkürler, birkaç kez denedim istediğim sonucu veriyor. Sadece şu var. Bu kodu Liste sayfası açık olmadan kullanmam gerekiyor, yani bir userform üzerinde buton altında ya da bir kod aralığına yerleştirmem gerekiyor. Farklı excel sayfaları açıkken sanırım aktif sayfada işlem yapmakta. Farklı excel sayfalarında çalışırken direk Liste adlı sayfada işlem yapmam gerekiyor. Buna göre düzeltebilir misiniz son olarak.

Teşekkürler desteğiniz için.

 

[Muzaffer Ali]

Dediğiniz gibi çalışacak şekilde kodu düzenledim.

 

[walabi]

Dediğiniz gibi çalışacak şekilde kodu düzenledim.

Teşekkürler yardımlarınız için, Hayırlı Günler