تلوين اكثر من كلمة مكررة فى عدة خلايا

[osama k q]

السلام عليكم 

الاساتذه الكرام ارجو المساعده فى هذا الموضوع 

هل يمكن ان اجعل اكثر من كلمه مكرره فى عده خلايا بالوان مختلفه 

الذى ابحث عنه موجود بوضوح اكثر فى ملف الاكسل المرفق 

اتمى وجود حل لهذه وشكرا جزيلا

تلوين الكلمات.xlsx

[محي الدين ابو البشر]

ربما؟

تلوين الكلمات.xlsm

[سليم حاصبيا]

Try This File

Option Explicit
 
Sub Regex_position(RG As Range, ByVal My_ExP As String)
    Dim rex As Object
    Dim Array_Pos() As Integer
    Dim Array_Mot() As String
    Dim Cnt%
    Dim My_Match, Sing_Match
    Dim K%
Set rex = CreateObject("Vbscript.Regexp")
 With rex
  .Pattern = My_ExP: .ignorecase = True: .Global = True
 End With

 If rex.test(RG) Then
   K = RG.Row
  Set My_Match = rex.Execute(RG)
   Cnt = 0
   For Each Sing_Match In My_Match
    ReDim Preserve Array_Pos(Cnt)
    ReDim Preserve Array_Mot(Cnt)
     Array_Pos(Cnt) = Val(Sing_Match.firstindex + 1)
     Array_Mot(Cnt) = Sing_Match
    Cnt = Cnt + 1
    Next
   For Cnt = LBound(Array_Pos) To UBound(Array_Pos)
   With RG.Characters(Array_Pos(Cnt), Len(Array_Mot(Cnt))).Font
    .ColorIndex = Sheets("Formula"). _
    Range("K1").Interior.ColorIndex
    .Size = 18: .Bold = True
    Sheets("Formula").Cells(K, "G") _
    .Offset(, Cnt) = Array_Mot(Cnt)
   End With
    Next
  End If

End Sub
'++++++++++++++++++++++++++++++++++++

Sub Colorize_Please()
 reset_me
Dim st, i%, lr
lr = Sheets("Formula").Cells(Rows.Count, 5).End(3).Row
st = "[A-Za-z]\d{2}"
  For i = 3 To lr
  Call Regex_position(Sheets("Formula").Range("E" & i), st)
  Next
Application.ScreenUpdating = True
End Sub
'+++++++++++++++++++++++++++++++++++++++++++++
Sub reset_me()
Dim x
With Sheets("Formula")
 x = .Cells(Rows.Count, 5).End(3).Row
.Range("G3:N" & x).ClearContents
    With .Range("E3:E" & x).Font
      .ColorIndex = 1
      .Bold = True: .Size = 14
    End With
End With
End Sub

 

osama.xlsm

[osama k q]

شكرا جزيلا اساتذتى الكرام