مجاهد2013 قام بنشر مارس 29, 2021 مشاركة قام بنشر مارس 29, 2021 السلام عليكم عندي في شيت data2 أريد إعفاء أساتذة مادة معينة يوم إمتحان تلك المادة و الكود المستعمل للأستاذ سليم تحياتي الخالصة له يقوم بهذا العمل و لكن لا يعمل في حالة تكرار نفس المادة مرتين أو ثلاثة في الاسبوع (يعفي الاستاذ الامتحان الاول فقط ) اريد التعديل إن أمكن ... ,وهذا هو الكود المستخدم للأستاذ سليم 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 My_File.xlsm رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.