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

إبراهيم العبادى · يوليو 2, 2020

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

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

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

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

**سليم حاصبيا** · يوليو 2, 2020

حرب هذا الملف

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