تلوين خلايا بشرط

[مجاهد2013]

السلام عليكم إخوتي :

أرجو مساعدتي

السؤال و التوضيح في الملف المرفق. و شكرا

 

2-

 

ملف.xlsm

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

من اولى الواجبات حفظ حقوق النشر

لماذا لم تذكر  اسم من وضع الكود لعملك؟؟؟.......

اذا تكرر الامر سأقوم أسفاً يحذف المشاركة

[مجاهد2013]

أستاذ سليم أسف فأنا لم اقصد سوى الاستفسار عن أمر أخر لاتمام هذا البرنامج و ليس من طبعي إنكار الجميل فأنا دائما أتقدم بالشكر لكل اساتذة المنتدى و كل من يقوم بمساعدتي و أنا أستاذ سليم مبتدئ و أقوم بطلب المساعدة على مراحل : فقد كنت قد طلبت ترحيلا بيانات الاساتذة بشرط و هو ما كان

أما اليوم فكنت أنوي إضافة جزء في البرنامج لا أكثر

أسف مرة أخرى مع احتراماتي للجميع و شكرا

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

ربما هذا الكود يقوم بالغرض

Sub colorize_table()
Application.ScreenUpdating = False
Dim Find_Rg As Range, r%, i%
Dim serch_range As Range
Set serch_range = Sheets("المعطيات").Range("R3:R12")
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 = 40
  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 = 6
Next_i:
 i = i + 1
Loop
Application.ScreenUpdating = True
End Sub

الملف مرفق

 

My_File.xlsm

[مجاهد2013]

ألف شكر أستاذ : الكود شغال مية مية إلا في حالة 02 مواد كما هو الحال في اليوم الثالث (علوم الطبيعة و الحياة و تكنولوجيا ) يشتغل على المادة الأولى

فهل بالامكان جعله يشتغل على 02 أو 03 مواد في نفس الفترة (الصباحية أو المسائية ) و شكرا تحياتي

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

6 دقائق مضت, مجاهد2013 said:

ألف شكر أستاذ : الكود شغال مية مية إلا في حالة 02 مواد كما هو الحال في اليوم الثالث (علوم الطبيعة و الحياة و تكنولوجيا ) يشتغل على المادة الأولى

فهل بالامكان جعله يشتغل على 02 أو 03 مواد في نفس الفترة (الصباحية أو المسائية ) و شكرا تحياتي

استبدل هذا السطر من الكود

Set serch_range = Sheets("المعطيات").Range("R3:R12")

بهذا    ( S بدل الـــــ  R  الثانية)

Set serch_range = Sheets("المعطيات").Range("R3:S12")

 

[مجاهد2013]

ألف شكر أستاذ سليم شغال تمام .

أسف مرة أخرى

سؤال أخر أستاذنا هل اطلعت على الموصوع الذي طرحته سابقا في المنتدى تحت عنوان (توزيع الحراسة ) و قد اخذت سؤال اليوم جزء منه و الذي أريد من خلاله توزيع آلي للحراس بشروط فهل ممكن المساعدة