AbuuAhmed

آمل تجربتهم بشكل مكثف والرجوع لنا بنتائج التجارب.
خوفي أن هذه الدوال موجودة في الأكسس وأنا لا أعلم بها ويذهب تعبي سدى.

تم تبديل المرفق في مشاركة لاحقة بعد تصحيح اخفاق في دالة Ceiling اكتشفه الاستاذ @husamwahab فشكرا له.

أخي،

بعد فحص جديد انتبهت أن عملية القفز مطلوبة لاختيار ملاحظ عشوائيا.
ولكن قمت بالتعديل على الشرط ليكون كالتالي:
- ابقاء أحد الشرطين القديمين وهو منع تكرار الملاحظ لنفس الفترة.
- منع دخول الملاحظ لفترتين متتاليتين.
- أن لا يزيد عدد حضوره عن 3 على أساس أن حصة الملاحظ من الفترات = 26 فترة مقسومة على 10 ملاحظين لتكون النتيجة 2.6 فترة

لقد قمت بتعطيل جزء في آخر الكود ، افحص النتائج أولا، وإذا وجدت أي ملاحظات وقبل أن ترجع لي فعل الجزء المعطل وافحص النتائج من جديد.
موفقين

ملاحظة_03.xlsm

21 ساعات مضت, AbuuAhmed said:

لا أعرف صحة النتائج فلم ولن أدخل في صحة معالجتها.

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

لقد قمت بالتالي:
- الإجراء مكرر مرتين وقد قمت بحذف أحدهما
- تم تنظيم الكود شكلا.
- حذف سطر يمنع مقاطعة الكود أثناء المعالجة، لا أرى له فائدة سوى عرقلة المبرمج لكشف أي تكرار بلا نهاية، كما حصل معي 🙂 .
- تعديل عدد الأعمدة بطرح 2
- تعطيل عملية قفز "GoTo 1" ، لا أرى أي فائدة لها، وبسببها يدخل الكود في تكرار بلا نهاية.

لا أعرف صحة النتائج فلم ولن أدخل في صحة معالجتها.
نصيحة للمبرمجين، تخلصوا من عملية القفز بقدر المستطاع، فعملية القفز بات حل قديم ومصدي.
 

ملاحظة_02.xlsm

2 ساعات مضت, jjafferr said:

معادلتك السابقة فيها دالتين غير موجودات في مثالك (باللون الاحمر)

أنا لا أحتفظ بأكوادي ، فكتبت لك الدالتبين من جديد.

Sub HijriYearTest()
  Dim Hyy As Integer
  Dim Days As Long
  Dim Greg As Long
  Dim Hijri1 As Long
  Dim Hijri2 As Double
  
  For Hyy = 1 To 9666
    Greg = Hijri2Greg(Hyy, 1, 1)
    For Days = Greg - 1 To Greg
      Hijri1 = Left(Greg2Hijri(CDate(Days)), 4)
     'Hijri2 = (Days + 466580.47) / 354.366666666667 + 1
      Hijri2 = (Days + 466581 - 0.53) / (10631 / 30) + 1
      If Hijri1 <> Fix(Hijri2) Then
        Debug.Print CDate(Days), Hijri1, Hijri2
      End If
    Next Days
  Next Hyy
  
  Debug.Print "Done"
End Sub

Function Hijri2Greg(yy As Integer, mm As Integer, dd As Integer) As Long
    Dim DefCal As VbCalendar
    
    DefCal = Calendar
    Calendar = vbCalHijri
    
    Hijri2Greg = DateSerial(yy, mm, dd)
    
    Calendar = DefCal
End Function

Function Greg2Hijri(DtSerial As Long) As String
    Dim DefCal As VbCalendar
    
    DefCal = Calendar
    Calendar = vbCalHijri
    
    Greg2Hijri = Format(DtSerial, "yyyy/mm/dd")
    
    Calendar = DefCal
End Function

شكرا لشيخ المنتدى جعفر 🙂 لفتح الموضوع وشكرا لكم جمعيا لتفاعلكم.
أنا أوافق بشدة في مراجعة القوانين والتوجيهات والاقتراحات.
وفقكم الله تعالى.

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

نعم يتم تحديثها عند زيادة أو نقص المواد

قم بزيادة مادة ثم اضغط زر "تنفيذ" من صفحة المسودة
ثم احذف المادة الزائدة واضغط زر "تنفيذ" مرة أخرى.
 

تم التعديل ، الآن يتم تحديث الأسماء بدون زيادة أو حذف مواد.
كذلك تمت بعض التنقيحات البسيطة.

توزيع القرار لمدارس العراق_03.xlsm

النسخة الثانية
تم تبديل الكود الأساس بالكامل وتم بناءه من جديد.
النتائج الآن أفضل والخيارات أوسع.
وشكر خاص للاستاذ سعد @saad 77 لتقديمه المعلومات المطلوبة لانهاء المشروع.

توزيع القرار لمدارس العراق_02.xlsm

تم التعديل
حسب تركيبة الجداول من قبلك باسم Type1
حسب تركيبة الجداول من قبلي باسم Type2

getValue_04.rar

التعديل في التقرير

getValue_03.accdb

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

getValue_02.accdb

تدري ليش أرد عليك ، لأن قلبي دائما يغلب عقلي ولكن في الخير إن شاء الله ، هل حلت مشكلتك؟

جرب هذا المثال ، ومسموح للخبراء التصرف به بالتعديل والتطوير.

DateEntryTest_01.accdb

CDate([Text104]) * 24 * 125

CDate("9:00") * 24 * 125

جهازك يرسل وما يستقبل ، يا أخي تفاعل مع من يقدم لك حلول لمشكلتك.
للحل ثلاث معالجات (تاريخ ورقم ونص) حسب نوع حقل الساعات.

الآن فقط فهمنا أن نوع الحقل عندك نص ، وأكيدا هذا خطأ في التصميم ومع ذلك حله سهل جدا.
وأنا عندي الحل بعد معرفة النوع ولكن لن أواصل معك ، البركة في الباقي.
ارفق مثالا وخذ الحل من الشباب بشكل صاروخي.
موفق.

مثال للتجربة

لقد رددت عليك في موضوع سابق ، ارجع له وحاول فهم ملاحظتي .
أخي كلنا مررنا بهذه المرحلة فلا تستحي من معاودة وتكرار الاستفهام في نفس الموضوع.
ولكي يتجاوب معك أعضاء المنتدى حاول أن ترفق مثالا ، فسوف تسهل المهمة عليك وعليهم.

getValue.accdb

1000 مبروك

ألف مبروك للخبير  .. يستاهلها بجدارة  

تم إضافة موضوع جديد لنسخة ديناميكية على هذا الرابط توزيع القرار لمدارس العراق

بالسبة لي لن أضيف على هذا الموضوع أي مشاركة جديدة ، فإذا رغب المشرف بغلق الموضوع فليفعل.
بالتوفيق للجميع.

هدية مني لمدارس العراق 
ديناميكي لا يحتاج لتدخل مبرمج أو خبير إكسل لتكييفه مع مراحل الدراسة المختلفة.

عن طريق صفحة التفاصيل:
- يقبل إضافة أو حذف مواد (عدد المواد).
- يقبل تبديل مسميات المواد لصفحتي المسودة والقائمة.
- يقبل تبديل درجة النجاح لكل المواد منفردة أي كل مادة على حدة.
- يقبل تبديل درجة القرار.
- يقبل تبديل درجة النجاح.
- يقبل تبديل عدد مواد الإكمال الأقصى.

توزيع القرار لمدارس العراق_01.xlsm

= 5:00 * 24 + 12:00 * 24 + 10:00 * 24 + 2:00 * 24 = 29.0

نوع الوقت لا يقبل أكثر من 24 ساعة.
والحل أن نحول الوقت إلى رقم عشري في ضربه في 24 ثم نجمعه

السلام عليكم

محاولة يمكن موجودة في المنتدى ولكني لم أبحث عنها
إن لم تكن موجودة فقد ينتفع بموضوعي أحدكم.
وظيفتهم تحويل "B" إلى 2        أو        تحويل 2 إلى "B"

Function C2L(Column As Integer) As String
    On Error Resume Next
    C2L = Replace(Replace(Cells(1, Column).Address, "$", ""), "1", "")
End Function

Function L2C(Letter As String) As Integer
    On Error Resume Next
    L2C = Range(Letter & "1").Column
End Function

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

حل الأستاذ @husamwahab صحيح

>=Year(Now())

ويمكن أن تكون بهذا الشكل أيضا:

>=Year(Date())

لي الشرف أستاذ ، توالصلنا إن شاء ليس الآن بل عندما ينتهي هذا الموضوع هنا.
بانتظار اختبار النسخة الأخيرة وخصوصا لملاحظتك الأخيرة.