كود لتلوين كل ثلاثة حروف بلون معين

[إبراهيم العبادى]

بسم الله الرحمن الرحيم

نظرا لأنى مبعرفشى اطرح سؤالى كويس

ده ملف اكسيل حاطط فيه المطلوب اللى انا عايزه

اللى هوا تلوين كل ثلاث أرقام بلون مختلف مثل كرقم الموبايل

المطلوب.xlsx

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

حرب هذا الملف

Option Explicit

Sub Get_Color()
Dim My_Regex        As Object
Dim x%, m%, La%, t%
Dim arrWords, Arr()
ReDim Arr(4)
 Arr(0) = 3: Arr(1) = 14: Arr(2) = 5: Arr(3) = 3
 Set My_Regex = CreateObject("VBScript.RegExp")
 My_Regex.Pattern = "(\d{3})"
 My_Regex.Global = True
 With Sheets("Sheet1")
     La = .Cells(Rows.Count, 3).End(3).Row
     m = 1
        With .Range("E6:E" & La)
         .Font.ColorIndex = 1
         .ClearContents
        End With
    For t = 6 To La
        .Range("E" & t) = .Range("C" & t)
          If My_Regex.test(.Range("E" & t)) Then
            Set arrWords = My_Regex.Execute(.Range("E" & t))
              For x = 0 To arrWords.Count - 1
                 Range("E" & t).Characters(m, 3) _
                 .Font.ColorIndex = Arr(x)
               m = m + 3
              Next x
          End If
        m = 1
    Next t
   End With
End Sub

الملف مرفق

Abbadi.xlsm

[إبراهيم العبادى]

شكرا لك أستاذ سليم على ذلك  الابداع

وعلى فكرة حضرتك فدتنى قبل كده

شكرا ليك مرة تانية وجعله الله فى ميزان حساناتك

[أحمد يوسف]

تمام أوى

  إبراهيم العبادى

أين الضغط على الإعجاب لهذا الكود الممتاز ؟!!!!💙

بارك الله فيك استاذ سليم كود رائع جعله الله فى ميزان حسناتك

[abouelhassan]

شكر وتقدير واحترام استاذ سليم بارك الله فيك