حل لكود التلوين

[سلامة على]

run sub عند الضغط على

يتم تلوين الكلمه ولكن لا تتوقف  ثم يكون الشيت ثقيل جدا

2030.xlsm

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

الشيت ثقيل لانك تجعل الكود ينتظر ثانية واحدة  في كل خطوة من خلال الدالة  Wait

ما مجموعه (55 × 57 =4125 ثانية اي حوالي ساعة وربع)

جرب هذا الماكرو

Sub salama()
Application.ScreenUpdating = False
Dim My_num, i#, col#
Dim color_index%
color_index = 1 + 18 * Rnd()
 For i = 3 To 55
   For col = 2 To 57
     Select Case Cells(i, col)
       Case 1: My_num = 2
       Case 2: My_num = 3
       Case 3: My_num = 1
       Case Else: My_num = ""
      End Select
     Cells(i, col) = My_num
     Cells(i, col).Interior.colorindex = color_index
  Next
 Next
 Application.ScreenUpdating = True
 End Sub
 '===================================
  'هذا الكود للتصحيح في حال ادخال رقم مختلف بالخطأ
Sub reset()
Application.ScreenUpdating = False
Dim i#, col#
 For i = 3 To 55
  For col = 2 To 57
   If Cells(i, col) <> vbNullString Then _
   Cells(i, col) = 1
  Next
 Next
 Application.ScreenUpdating = True
End Sub

 

2030.xlsm

[Ali Mohamed Ali]

أحسنت أستاذ سليم كود ممتاز جعله الله في ميزان حسناتك وغفر لك وزادك من فضله

[وجيه شرف الدين]

ما شاء الله روعة استاذ سليم

[سلامة على]

 شكرا على المجهود