Excelde yazarken renk değiştirme

[graphic]

Kolay gelsin, excelde bir hücrede yazı yazarken belli bir karakter sonra otomatik renk değişimini sağlayabilir miyiz? Mesela "dünyayı gezmek istiyorum" yazarken istiyorum kelimesi kırmızı olsun gibi.
Teşekkürler.

İyi günler.

 

[Murat OSMA]

Yazarken değil de, yazdıktan sonra olabilir.​

 

[graphic]

O da olur, nasıl yapıyoruz acaba?
Teşekkürler.

 

[Korhan Ayhan]

Sayfanızın kod bölümüne uygulayıp deneyiniz.

A1:A100 arasına veri girişi yapıp hücreden çıktığınızda kod çalışır. Son kelimeyi kırmızı yapar.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A1:A100")) Is Nothing Then Exit Sub
    Target.Font.ColorIndex = 0
    If Target <> "" Then
        Say = Evaluate("=MAX(IF(MID(""" & Target.Text & """,ROW(1:1024),1)="" "",ROW(1:1024)))")
        Target.Characters(Say, Len(Target) - Say + 1).Font.ColorIndex = 3
    End If
End Sub

 

[graphic]

Olmadı, bir şeyi eksik yaptım sanırım..

 

[Korhan Ayhan]

Sayfa ismi üzerinde sağ klik yapın ve Kod Görüntüle seçeneğini seçin.
Karşınıza gelen beyaz pencereye önerdiğim kodu uygulayın.
Daha sonra excel sayfanıza dönün.
A1:A100 aralığına bir şeyler yazıp deneyin.

 

[Murat OSMA]

Alternatif;

[FONT="Trebuchet MS"][SIZE="2"]Private Sub Worksheet_Change(ByVal Target As Range)
    [COLOR="DarkOrange"]kelime [/COLOR]= "[COLOR="red"]istiyorum[/COLOR]"
    [COLOR="Magenta"]bul [/COLOR]= [COLOR="red"]InStr[/COLOR](1, Target.Value, [COLOR="DarkOrange"]kelime[/COLOR])
    Target.[COLOR="red"]Characters[/COLOR]([COLOR="Magenta"]bul[/COLOR], [COLOR="red"]Len[/COLOR]([COLOR="DarkOrange"]kelime[/COLOR])).[COLOR="Blue"]Font.ColorIndex[/COLOR] = [COLOR="Red"]3[/COLOR]
End Sub[/SIZE][/FONT]

 

[graphic]

Evet oldu, teşekkürler.
Peki belli bir karakter geçtikten sonra kırmızı olsun istiyorsak, boşlukları da sayarak belli bir miktar karakter geçtikten sonra kırmızı yapmak istiyorsak ne yapmalıyız? Mesela kırk karakter ( boşluklarla beraber )geçsin ama sonra yazdıklarımız kırmızı olsun.
Teşekkürler.

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A1:A100")) Is Nothing Then Exit Sub
    Target.Font.ColorIndex = 0
    If Len(Target) > 40 Then
        Target.Characters(41, 1024).Font.ColorIndex = 3
    End If
End Sub

 

[graphic]

Oldu, çok teşekkür ederim...