Merhaba,
Hücre içerisinde Alt+Enter ile alt alta birden fazla satıra yayılan düz metinler yazıyorum. Bu metinlerin içerisindeki bazı kelimeleri renklendirmek ve bold yapmak istiyorum. Bir arkadaşın hazırladığı makroyu biraz değiştirdim işe yaradı ama sadece hücredeki ilk kelimeyi renklendiriyor. Aynı kelime birden fazla geçiyorsa renklendirme yapmıyor. Hücre içeriside aranacak kelime kaç tane olursa olsun hepsini nasıl renklendiririm.
Sub Pgm()
Dim aranacak$, baslangic%, i&
Dim aranacak1$, baslangic1%, ii&
Dim aranacak2$, baslangic2%, iii&
aranacak = "PgM Comments:"
For i = 1 To Cells(Rows.Count, "D").End(3).Row
baslangic = InStr(1, Range("D" & i).Value, aranacak, 1)
If baslangic > 0 Then Range("D" & i).Characters(baslangic, Len(aranacak)).Font.ColorIndex = 5
If baslangic > 0 Then Range("D" & i).Characters(baslangic, Len(aranacak)).Font.Bold = True
Next i
aranacak1 = vbNullString: baslangic1 = Empty: ii = Empty
aranacak1 = "Project Review Mails:"
For ii = 1 To Cells(Rows.Count, "D").End(3).Row
baslangic1 = InStr(1, Range("D" & ii).Value, aranacak1, 1)
If baslangic1 > 0 Then Range("D" & ii).Characters(baslangic1, Len(aranacak1)).Font.ColorIndex = 3
If baslangic1 > 0 Then Range("D" & ii).Characters(baslangic1, Len(aranacak1)).Font.Bold = True
Next ii
aranacak1 = vbNullString: baslangic1 = Empty: ii = Empty
aranacak2 = "Jira Comments:"
For iii = 1 To Cells(Rows.Count, "D").End(3).Row
baslangic2 = InStr(1, Range("D" & iii).Value, aranacak2, 1)
If baslangic2 > 0 Then Range("D" & iii).Characters(baslangic2, Len(aranacak2)).Font.ColorIndex = 7
If baslangic2 > 0 Then Range("D" & iii).Characters(baslangic2, Len(aranacak2)).Font.Bold = True
Next iii
aranacak2 = vbNullString: baslangic2 = Empty: iii = Empty
End Sub
Destekleriniz için teşekkürler.
Hücre içerisinde Alt+Enter ile alt alta birden fazla satıra yayılan düz metinler yazıyorum. Bu metinlerin içerisindeki bazı kelimeleri renklendirmek ve bold yapmak istiyorum. Bir arkadaşın hazırladığı makroyu biraz değiştirdim işe yaradı ama sadece hücredeki ilk kelimeyi renklendiriyor. Aynı kelime birden fazla geçiyorsa renklendirme yapmıyor. Hücre içeriside aranacak kelime kaç tane olursa olsun hepsini nasıl renklendiririm.
Sub Pgm()
Dim aranacak$, baslangic%, i&
Dim aranacak1$, baslangic1%, ii&
Dim aranacak2$, baslangic2%, iii&
aranacak = "PgM Comments:"
For i = 1 To Cells(Rows.Count, "D").End(3).Row
baslangic = InStr(1, Range("D" & i).Value, aranacak, 1)
If baslangic > 0 Then Range("D" & i).Characters(baslangic, Len(aranacak)).Font.ColorIndex = 5
If baslangic > 0 Then Range("D" & i).Characters(baslangic, Len(aranacak)).Font.Bold = True
Next i
aranacak1 = vbNullString: baslangic1 = Empty: ii = Empty
aranacak1 = "Project Review Mails:"
For ii = 1 To Cells(Rows.Count, "D").End(3).Row
baslangic1 = InStr(1, Range("D" & ii).Value, aranacak1, 1)
If baslangic1 > 0 Then Range("D" & ii).Characters(baslangic1, Len(aranacak1)).Font.ColorIndex = 3
If baslangic1 > 0 Then Range("D" & ii).Characters(baslangic1, Len(aranacak1)).Font.Bold = True
Next ii
aranacak1 = vbNullString: baslangic1 = Empty: ii = Empty
aranacak2 = "Jira Comments:"
For iii = 1 To Cells(Rows.Count, "D").End(3).Row
baslangic2 = InStr(1, Range("D" & iii).Value, aranacak2, 1)
If baslangic2 > 0 Then Range("D" & iii).Characters(baslangic2, Len(aranacak2)).Font.ColorIndex = 7
If baslangic2 > 0 Then Range("D" & iii).Characters(baslangic2, Len(aranacak2)).Font.Bold = True
Next iii
aranacak2 = vbNullString: baslangic2 = Empty: iii = Empty
End Sub
Destekleriniz için teşekkürler.
