بلانك

لان عند الضغط بداخلها تتغير النتائج ولابد من الضغط على كنترول وشيفت وانتر هذا هو السبب ولكن ... خلاص لانها تعطي النتائج المرجوه والف شكر على الاستجابه السريعة

هل يمكن تغير معادلة صفيف باخرى ؟؟؟؟؟؟؟؟؟؟

بارك الله فيك وجعله في ميزان اعمالك

الشرح داخل الملف مرة اخرى .... كشف الملاحظة يدوي واريد وضع الملاحظين في كشف الملاحظة على حسب كل يوم _اكمال ملاحظة2.xlsx

المطلوب بالملف اكمال ملاحظة.xlsx

عمل جميل جدا ولكن هناك عدة ملاحظات ١ لا يوجد بالكشف مراقبين أدوار ٢مامعنى جدول ملاحظة٣ اين المراقب الاول ومراقب الكنترول ورئيس اللجنة انا بتكلم على الشهادة الثانوية وليس النقل٤ كشف الملاحظة انظر للملف المرفق اريد مثله بالضبط واخيرا لك الف تحية وسلام على المجهود والرد

الجدول الموجود في الملف حقيقي بالتواريخ واليوم والمادة اريد تفريغ الملاحظين في كشف الملاحظة لكل مادة باليوم والتاريخ واضافة الاحتياطي من الملاحظين الفارغين من الملاحظة بالاحتياطي واستعمال زر Spinner لتغير اليوم والتاريخ والمادة حسب الجدول وعند الطباعة يتم طباعة جميع الايام مرة واحدة رقم 2 من استفسارك هو الارجح

استاذي الكريم محمد بك هشام نفس التصميم ولا يوجد اعمدة محذوفة أكرمك الله وشكرا مقدما للاستجابة السريعة

المطلوب عند اختار اليوم والتاريخ والمادة يتم ملئ استمارة ( م .ث) كشف الملاحظة اتوماتيكيا ويتم تحريك الايام والتاريخ والمادة عن طريق Spinner ...... طلب اخر عدد الملاحظين 74 وعدد اللجان 31 يعني 62 ملاحظ اذن الباقي 12 ملاحظ ياريت كل 12 ملاحظ يتم وضعهم في الاحتياطي بتعديل في كود التوزيع توزيع الملاحظين 2025.rar

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

المقصود ان لكل ملاحظ مسلسل يتم التوزيع من خلال مسلسلة لتسهيل التوزيع بدلا من الاسماء في العمود 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