Hücredeki renkli kelimelerin sayısı

[tahsinanarat]

Ekli örnek dosyamda; A sutununda bulunan hücrelerdeki renkli olan kelimelerin sayısını B sutunana yazdırmak istiyorum. Yardımcı olacak arkadaşlarıma şimdeden teşekkür ederim. Saygılarımla. Tahsin

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz. Bazı verilerde hatalı sonuç vermektedir. Kontrol etmeyi unutmayın.

Option Explicit
 
Sub RENKLİ_KELİME_SAY()
    Dim KELİME As Variant, X As Long, Y As Integer, BUL As Integer
    
    Columns(2).ClearContents
    
    For X = 1 To Range("A65536").End(3).Row
    KELİME = Split(Trim(Cells(X, 1)), " ")
        For Y = 0 To UBound(KELİME)
            BUL = WorksheetFunction.Search(KELİME(Y), Cells(X, 1), 1)
            If Cells(X, 1).Characters(Start:=BUL, Length:=1).Font.ColorIndex = 5 Then
            Cells(X, 2) = Cells(X, 2) + 1
            End If
        Next
    Next
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[tahsinanarat]

Evet hocam genelde 4 ve 5 kelime üstünde olanlarda hata vermekte, Bu bile büyük ölçüde işimi kolaylaştıracak, Elineze sağlık. Çok teşekkür ederim.