توزيع مواقيت الأقسام على الأساتذة آليا

[بوعلام]

السلام عليكم ورحمة الله تعالى وبركاته

أولا رمضان مبارك وكل عام وانتم بخير

لقد تعلمت الكثير الكثير من هذا المنتدى الرائع ورأيت بأم عيني ما يستطيع الاكسل فعله فأحببت أن أعرف هل الاكسل يستطيع فعل المطلوب التالي وهو بمجرد حجز مواقيت الاقسام ينجز مواقيت اّلأساتذة اليا.

ولكم جزيل الشكر

المواقيت.rar

[طارق محمود]

السلام عليكم

أخي الحبيب / بوعلام

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

ثانيا

تفضل

هذا الكود

 

Sub t_booking()

Dim sh As Worksheet

Sheets("مواقيت الأساتدة").Activate

last_row = [B10000].End(xlUp).Row

Set sh = Sheets("حجز مواقيت الأقسام")

last_row2 = sh.[D10000].End(xlUp).Row


For rr = 8 To last_row

    If Cells(rr, 2) = "" Then GoTo 10

    t_name = Cells(rr, 2)


    For day_col = 6 To 14 Step 2


        For j = 8 To last_row2

           If sh.Cells(j, day_col) = t_name Then

                t_time2 = sh.Cells(j, 4)

                t_deprt = sh.Cells(8 * Int(j / 8), 2) & " -- " & sh.Cells(j, 5)

                new_col = day_col / 2 + 2

                    For i = 0 To 7

                        t_time = Cells(rr + i, 4)

                        If t_time = t_time2 Then Cells(rr + i, new_col) = t_deprt

                    Next i


           End If

        Next j

    Next day_col


10

Next rr


End Sub

وهذا المرفق ، إضغط الزر الأزرق "مواقيت الأساتدة"

المواقيت.rar

[بوعلام]

السلام عليكم

أخي الحبيب / بوعلام

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

ثانيا

تفضل

هذا الكود

 

Sub t_booking()

Dim sh As Worksheet

Sheets("مواقيت الأساتدة").Activate

last_row = [B10000].End(xlUp).Row

Set sh = Sheets("حجز مواقيت الأقسام")

last_row2 = sh.[D10000].End(xlUp).Row


For rr = 8 To last_row

    If Cells(rr, 2) = "" Then GoTo 10

    t_name = Cells(rr, 2)


    For day_col = 6 To 14 Step 2


        For j = 8 To last_row2

           If sh.Cells(j, day_col) = t_name Then

                t_time2 = sh.Cells(j, 4)

                t_deprt = sh.Cells(8 * Int(j / 8), 2) & " -- " & sh.Cells(j, 5)

                new_col = day_col / 2 + 2

                    For i = 0 To 7

                        t_time = Cells(rr + i, 4)

                        If t_time = t_time2 Then Cells(rr + i, new_col) = t_deprt

                    Next i


           End If

        Next j

    Next day_col


10

Next rr


End Sub

وهذا المرفق ، إضغط الزر الأزرق "مواقيت الأساتدة"

السلام عليكم ورحمة الله تعالى وبركاته

شكرا جزيلا أخي طارق والله هذا هو المطلوب فعلا فجزاك الله كل خير وجعل ما تقومون به في ميزان حسناتكم

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

[ياسر الحافظ]

الاستاذ م. طارق :

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

جزاك الله كل الخير على الكود الجميل المتقن

وفقك الله ... ويسر امرك

ياسر الحافظ " ابو الحارث "

[بوعلام]

السلام عليكم ورحمة الله تعالى وبركاته

شكرا على مرورك أخي ياسر

وسؤالي للأخ طارق عند تصفحي للملف وجدت أنه عند الضغط على الزر الأزرق فنجد محمد1 مثلا لديه قسم 4م1 عربية ثم نجد أيضا أن نفس الأستاذ لدية 4م1 اجتماعيات وهذا غير ممكن لأن الأستاذ متخصص بمادة واحدة فقط وهي العربية

فما الحل ياأخي طارق

دمت بود.

[MAHMOUD ALI YOUSSEF]

السلام عليكم

حمدا لله علي سلامتك

عودا مباركا استاذ طارق

وجزاك الله كل خير

:clapping:

:fff: :fff: :fff:

[طارق محمود]

السلام عليكم ورحمة الله تعالى وبركاته

شكرا على مرورك أخي ياسر

وسؤالي للأخ طارق عند تصفحي للملف وجدت أنه عند الضغط على الزر الأزرق فنجد محمد1 مثلا لديه قسم 4م1 عربية ثم نجد أيضا أن نفس الأستاذ لدية 4م1 اجتماعيات وهذا غير ممكن لأن الأستاذ متخصص بمادة واحدة فقط وهي العربية

فما الحل ياأخي طارق

دمت بود.

السلام عليكم

عندك أخي بوعلام

فالسطر التالي يضع إسم المادة الأولي في الصف

   	t_deprt = sh.Cells(8 * Int(j / 8), 2) & " -- " & sh.Cells(j, 5)

وهو سطر في منتصف الكود والمفروض ان يضع إسم المادة المجاورة للأستاذ تماما بنفس التنسيق في ورقة "حجز مواقيت الأقسام" لذلك فقط عدل هذا السطر ليكون

t_deprt = sh.Cells(8 * Int(j / 8), 2) & " -- " & sh.Cells(j, day_col-1)

ويكون الكود كله بعد التعديل

Sub t_booking()

Dim sh As Worksheet

Sheets("مواقيت الأساتدة").Activate

last_row = [B10000].End(xlUp).Row

Set sh = Sheets("حجز مواقيت الأقسام")

last_row2 = sh.[D10000].End(xlUp).Row


For rr = 8 To last_row

    If Cells(rr, 2) = "" Then GoTo 10

    t_name = Cells(rr, 2)


    For day_col = 6 To 14 Step 2


        For j = 8 To last_row2

           If sh.Cells(j, day_col) = t_name Then

                t_time2 = sh.Cells(j, 4)

                t_deprt = sh.Cells(8 * Int(j / 8), 2) & " -- " & sh.Cells(j, day_col-1)                                      ' هذا هو التعديل

                new_col = day_col / 2 + 2

                    For i = 0 To 7

                        t_time = Cells(rr + i, 4)

                        If t_time = t_time2 Then Cells(rr + i, new_col) = t_deprt

                    Next i


           End If

        Next j

    Next day_col


10

Next rr


End Sub

[طارق محمود]

السلام عليكم

حمدا لله علي سلامتك

عودا مباركا استاذ طارق

وجزاك الله كل خير

:clapping:

:fff: :fff: :fff:

أخي الكريم / محمود علي

جزاك الله خيرا

وأشكرك انت وجميع الإخوة بالمنتدي

وتقبلوا وافر إحترامي

[بوعلام]

السلام عليكم ورحمة الله تعالى وبركاته

أخي طارق بارك الله فيك ودمت بالصحة والوفاء

بالفعل تم التعديل على الكود وهو المطلوب فعلا فجزاك الله كل خير

تقبل تحياتي أخوك بوعلام

[بوعلام]

السلام عليكم ورحمة الله وبركاته

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

تم تعديل يوليو 28, 2011 بواسطه بوعلام

[طارق محمود]

السلام عليكم

أخي بو علام

تقول

لقد تم بالفعل انجاز مواقيت الأساتذة آليا

لكن صادفتني مشكلة أخرى وهي في الحصص المشتركة مثلا علوم/فيزياء

نجد مثلا محمد1/جمال1

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

لم أفهم : ليتك ترفق ملف موضح عليه المطلوب فالأستاذين محمد1/جمال1 حسب مثالك يدرسون عربية /رياضيات وليس علوم/فيزياء

[بوعلام]

السلام عليكم أخي طارق وألف شكر على اهتمامك

اعذرني على عد م شرحي بالشكل المطلوب مما صعب عليك عملية الفهم

الشرح بالمرفق وألف شكر مسبقا

رمضان كريم

المواقيت.rar