بلانك

بارك الله فيك هو دا المطلوب

المقصود ان لكل ملاحظ مسلسل يتم التوزيع من خلال مسلسلة لتسهيل التوزيع بدلا من الاسماء في العمود A والعمود B يمثل ارقام اللجان

للاسف يعطي عند التنفيذ ويمسح ارقام الملاحظين انظر الى الصورتين

ثانيا: عند حق فيما ذكرت من كثرة الشروط وانت اعلم مني إنها مطلوبة حتى لا يدخل ملاحظ اكثر من الثاني او يتكرر دخول نفس اللجنة اكثر من مرة او تضارب الدخول للجنتين في نفس الوقت وهذة هي الاحتمالات ولهذا .... هي الشروط المطلوبة فعذرا مني وغصب عني

اولا شكرا على تعبك ولكن غند تنفيذ الكود يعطي خطأ لاحظ الصورة

Sub Observer222() ActiveSheet.Unprotect "0" Dim password As String, x As Long password = "0" If Application.InputBox("inter password", "login") <> password Then MsgBox "worng password", vbInformation, "error" Exit Sub End If Dim row As Integer, col As Integer, r As Integer, c As Integer, n As Integer Dim lr1 As Integer, lr2 As Integer, lc1 As Integer Dim max As Integer Application.ScreenUpdating = False On Error Resume Next Worksheets("ÇáÍÇÑÓ ÇáÇæá").Select lr1 = Cells(Rows.Count, 2).End(xlUp).row lr2 = Cells(Rows.Count, 3).End(xlUp).row lc1 = Cells(2, Columns.Count).End(xlToLeft).Column - 0 max = (lc1 - 4) / (lr1 - 2) If max > Fix(max) Then max = max + 1 Range(Cells(3, 4), Cells(lr2, lc1)).ClearContents n = Round(Application.CountBlank(Range(Cells(3, 4), Cells(lr2, lc1))) / (lr1 - 2)) For row = 3 To lr2 DoEvents For col = 4 To lc1 1: DoEvents Cells(row, col) = Application.Index(Range("b3:b" & lr1), Application.RandBetween(1, lr1 - 2)) If Application.CountIf(Range(Cells(row, col - 1), Cells(row, col)), Cells(row, col)) <> 1 Or _ Application.CountIf(Range(Cells(row, 4), Cells(row, lc1)), Cells(row, col)) > max Or _ Application.CountIf(Range(Cells(3, col), Cells(lr2, col)), Cells(row, col)) <> 1 Then GoTo 1 End If 2: Next col Next row For c = 3 To lr1 DoEvents Cells(c, 1) = Application.CountIf(Range(Cells(3, 4), Cells(lr2, lc1)), Cells(c, 2)) Next Application.ScreenUpdating = True MsgBox "Done" ActiveSheet.Protect "0" End Sub

المطلوب داخل الملف ..... وهنال العديد من هذة البرامج ولكن يظهر بها الاخطاء في التوزيع كود.xlsx

المطلوب بالملف ... وشكرا مقدما لمن يساعدني ملاحظة.xlsx

بارك الله فيكFoksh .... الكود سريع وجميل جدا جعلة الله في ميزان حستاتك

عند توزيع الملاحظين على اللجان وعددها 30 لجنة ثانوية عامة وعدد الملاحظين 65 كود التوزيع بطئ جدا جدا وياخذ وقت طويل جدا ...... برجاء تعديل الكود او إنشاء كود جديد .... بشرط : 1- عدم تكرار ملاحظ في نفس اللجنة بحيث يمر على جميع اللجان بقدر الامكان طوال الامتحانات . 2- تساوي مرات دخول الملاحظين على اللجان قدر الامكان. ملاحظة_ث.ع.xlsm

بارك الله فيك استاذنا / محمد هشام وجعله في ميزان حسناتك وعيد اضحى سعيد عليك

المطلوب بالملف كود إخفاء وإظهار.xlsb

بارك الله فيك وجعله في ميزان حسناتك . وعيد اضحى كريم عليك

الكود لمعرفة الفرق _ مطلو ب بالملف درجات المواد.xlsx

بالفعل بوضع معادلتك بالشيت الرئيسي ظبطت كل الشيتات .... مرة اخرى الف شكر وجزاك الله كل خير