- Katılım
- 1 Temmuz 2005
- Mesajlar
- 2,607
- Excel Vers. ve Dili
- Ofis 2013 TR 64 Bit
Merhaba,Sayın dEdE,
Verdiğiniz kod aslında ihtiyacım olan kod. Verdiğiniz linkteki duruma uygun şekilde yaptım, sanki kafasına göre sadece birkaç ismi kırmızı yaptı.
Küçük bir örnek dosyayı ekte gönderiyorum. İlgilenirseniz çok sevinirim.
Saygılarımla
Aşağıdaki kodu dener misiniz?
Kod:
Sub BulBoya()
On Error Resume Next
For i = 2 To Range("A" & Rows.Count).End(3).Row
x = Len(Cells(i, 1).Value)
For j = 2 To Range("C" & Rows.Count).End(3).Row
q = 1
Do
p = WorksheetFunction.Find(Cells(i, 1), Cells(j, 3), q)
If p = 0 Then GoTo atla
Cells(j, 3).Characters(p, x).Font.ColorIndex = 3
q = p + x
p = 0
atla:
Loop While Not IsError(WorksheetFunction.Find(Cells(i, 1), Cells(j, 3), q))
Next
Next
End Sub