Hücre icinde kelime arama ve atama

[ozgurmail]

Merhabalar,
Bir hücre içinde geçen kelimeyi bulup başka hücreye başka bir kelime atamak istiyorum.

Örneğin A sütünunda aşağıdakiler yazıyor.

A1 SU BARDAĞI
A2 ÇAY BARDAĞI
A3 BİRA BARDAK
A4 ÇATAL
A5 KAŞIK

İstediğim A sütununda "BARDA" aratıp bulduğu ürünlerin aynı satırda B sütünunda BARDAK ya da başka bir şey yazdırmak.

Acemi olarak ilk sorumu cevaplarsanız memnun olurum.
teşekkürler

 

[ÖmerBey]

Merhaba,
Foruma hoş geldiniz.
Aşağıdaki kodu boş bir modüle kopyalayıp deneyiniz.

Sub KOD()
ara = Application.InputBox("A sütununda aramak için bir değer giriniz.")
Set b = Range("A:A").Find(ara, , , 2)
If Not b Is Nothing Then
    adr = b.Address
    Do
        cvp = MsgBox("Eşleşme bulundu." & Chr(10) & _
        Replace(b.Address, "$", "") & ": " & b.Text & Chr(10) & Chr(10) & _
        "B sütununda değişiklik yapılsın mı?", vbYesNoCancel, "Aranan Değer: " & ara)
        
        If cvp = vbCancel Then
            Exit Sub
        ElseIf cvp = vbYes Then
            b.Offset(0, 1) = Application.InputBox("B sütununa girilecek değeri giriniz.")
            Exit Sub
        End If
        
        Set b = Range("A:A").FindNext(b)
    Loop Until b.Address = adr
Else
    MsgBox "Aradığınız değer bulunamadı."
End If
End Sub