السلام عليكم
عندي في شيت data2 أريد إعفاء أساتذة مادة معينة يوم إمتحان تلك المادة و الكود المستعمل للأستاذ salim تحياتي الخالصة له يقوم بهذا العمل و لكن لا يعمل في حالة تكرار نفس المادة مرتين أو ثلاثة في الاسبوع (يعفي الاستاذ الامتحان الاول فقط )
اريد التعديل إن أمكن .... وهذا هو كود الأستاذ سليم المستخدم
CODE
Option Explicit
Sub colorize_table()
Application.ScreenUpdating = False
Dim Find_Rg As Range, r%, i%
Dim serch_range As Range
Set serch_range = Sheets("ÇáãÚØíÇÊ").Range("R3:U12")
Dim start_rg As Range
Dim last_ro%: last_ro = Sheets("data2").Cells(Rows.Count, 2).End(3).Row
Dim k%
For k = 9 To 18 Step 2
Cells(6, k).Resize(last_ro - 4).Interior.ColorIndex = 35
Cells(6, k + 1).Resize(last_ro - 4).Interior.ColorIndex = 24
Next
i = 7
Do Until Sheets("data2").Range("c" & i) = vbNullString
Set start_rg = Sheets("data2").Range("H" & i)
Set Find_Rg = serch_range.Find(Sheets("data2").Range("c" & i))
If Not Find_Rg Is Nothing Then
r = Find_Rg.Row - 2
Else: GoTo Next_i
End If
start_rg.Offset(, r).Interior.ColorIndex = 25
Next_i:
i = i + 1
Loop
Application.ScreenUpdating = True
End Sub
