Metinde Kelimeleri Bulup Boyamak

[atilla13]

Ek'te gönderdiğim dosyada görüldüğü gibi, A1:A50 aralığında bulunan kelimelerden birinin C1:C200 aralığında geçmesi halinde,
ilgili satırın kırmızı (yada görünür herhangi bir renge) boyanmasına ihtiyacım var.
Herkese teşekkürler.

soru.png

[erseldemirel]

Bu kod ile işlem yapılıyor.

Kod: Tümünü seç

Sub test()
Set sayfa = ThisWorkbook.Sheets("TEST")
Set kelimeler = sayfa.Range("A1:A50")
For Each hucre In sayfa.Range("C1:C200")
hucre.Interior.ColorIndex = xlNone
For Each kelime In kelimeler
If Not IsEmpty(kelime.Value) Then
If InStr(1, hucre.Value, kelime.Value, vbTextCompare) > 0 Then
hucre.Interior.Color = RGB(255, 0, 0)
Exit For
End If
End If
Next kelime
Next hucre
End Sub

[atilla13]

Tam istediğim gibi olmuş. Çok teşekkürler.

[erseldemirel]

Kolay gelsin