Noktalı virgülle ayrılmış anahtar kelimeleri bu karakterden böler ve her anahtar kelime için arama yapar. Eğer eşit değer bulursa renk dizisinde verilen renk indekslerinden birisi sırasıyla kullanılarak renklendirilir.
Option Explicit
Sub AraBulRenklendirCokluAlan()
Dim aranan As String
Dim aramaAlani As Range
Dim hucre As Range
Dim arananDizi As Variant
Dim renkIndeks As Variant
Dim i As Long
Set aramaAlani = Range("A1:G25")
aramaAlani.Interior.ColorIndex = xlNone
renkIndeks = Array(3, 4, 5, 6, 7, 8, _
10, 12, 14, 15, 16, _
17, 18, 22, 23, 26, 27)
aranan = InputBox("Aranan: ")
arananDizi = Split(aranan, ";")
For Each hucre In aramaAlani
For i = LBound(arananDizi) To UBound(arananDizi)
If (hucre.Text = arananDizi(i)) Then
hucre.Interior.ColorIndex = renkIndeks(i)
End If
Next
Next
End Sub
Option Explicit
Sub AraBulRenklendirCokluAlan()
Dim aranan As String
Dim aramaAlani As Range
Dim hucre As Range
Dim arananDizi As Variant
Dim renkIndeks As Variant
Dim i As Long
'--------------------------------------------------
'Arama yapılacak alanı ayarladık.
'--------------------------------------------------
Set aramaAlani = Range("A1:G25")
'--------------------------------------------------
'Arama yapılacak alandaki arkaplan renklerini
'karışıklık yaşanmaması için sildik.
'--------------------------------------------------
aramaAlani.Interior.ColorIndex = xlNone
'--------------------------------------------------
'Standart excel düzenine göre hem renklendirmesi
'iyi olan, hem de yazıyı boğmayan bir renk listesi
'hazırladım. Siz duruma göre değiştirebilirsiniz.
'Bunu da dizi olarak kullanacağız.
'--------------------------------------------------
renkIndeks = Array(3, 4, 5, 6, 7, 8, _
10, 12, 14, 15, 16, _
17, 18, 22, 23, 26, 27)
'--------------------------------------------------
'Anahtar kelimeleri noktalı virgülle ayırarak
'giriyoruz. Sonra bu karakterden bölüp tek tek
'aratabileceğiz.
'--------------------------------------------------
aranan = InputBox("Aranan: " & vbCrLf & _
"(Birden fazla arama yapmak için anahtar kelimelerin arasına noktalı virgül ekleyin.)")
'--------------------------------------------------
'InputBox aracılığıyla kullanıcıdan gelen veriyi
'Split ile böldük. Bu metod bölünen metni dizi olarak
'saklıyor. Biz de kendi tanımladığımız değişkeni
'kullanmak istediğimizden dolayı Split sonucunu
'kendi dizi değişkenimize aktardık.
'--------------------------------------------------
arananDizi = Split(aranan, ";")
'--------------------------------------------------
'Verilen alandaki her hücre için kontrol yapıyoruz.
'--------------------------------------------------
For Each hucre In aramaAlani
'--------------------------------------------------
'Hücreyi her arama kelimesi için kontrol ediyoruz.
'--------------------------------------------------
For i = LBound(arananDizi) To UBound(arananDizi)
'--------------------------------------------------
'Eğer anahtar kelimelerden biri hücredeki
'değere eşitse renklendirme yap.
'
'Bu arada renkIndeks dizisinden fazla anatar
'kelime girilmişse hata verecektir, siz
'artık buna göre ayarlama yaparsınız.
'Mesela renk indeks dizisine
'renk indeksi eklemek,
'RGB renkleri kullanmak gibi.
'--------------------------------------------------
If (hucre.Text = arananDizi(i)) Then
hucre.Interior.ColorIndex = renkIndeks(i)
End If
Next
Next
End Sub