اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

قام بنشر

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

1- علمي العلوم يجب ان تكون امامه مادة الاحياء

2- علمي الرياضة يجب ان يكون امامه مادة ريلضة2

3- الادبي يكون امامه الجيولوجيا

4- التاريخ تكون في مجموعة الطلبة الادبي محول

جزاكم الله خير وجعله في ميزان حسناتكم

قام بنشر

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

قام بنشر

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

أم المرفق الذي قمت بتقديمة

لوكان مرفقي أنا قمت بتتغيير فية الأسماء والمواد قام بتتغييرها

قام بنشر (معدل)
صف ثالث.rarتم التعديل والتجريب علي ملف الأخ أبو حنين وتعديل الملف كما اضاف أ- يوسف ووضع تخصص كما بالمرفق نرجو المساعدة تم تعديل بواسطه ara6367
قام بنشر

جرب المرفق

ملحوظة

قبل الضغط على زر الترحيل لابد من مسح البيانات القديمة بالضغط على زر مسح فى كل شيت خاص بقسم

تم تغيير مسميات الشيت لعمل الكود

صف ثالث.rar

قام بنشر

تفضل يا الغالى وأعتذر عن التأخير لإنقطاع الكهرباء

هذا الملف يقوم بالتالى

1. تغيير قسم الطالب بمجرد تغيير المادة صاحبة شرط الدخول للقسم

2. يقوم بعمل مسلسل لكل قسم

3. يقوم بإخراج إحصاء لكل قسم

4. يقوم تلقائياً بمسح الترحيلات السابقة عند الضغط على زر الترحيل مرة أخرى حتى لا تتراكم الداتا تحت بعضها

صف ثالث.rar

قام بنشر

الكود فى الملف يقوم بترحيل 9 أعمدة فقط

لزيادة عدد الأعمدة يتم تغيير هذا الجزء من الكود الذى يتكرر فى كل شيت ترحيل


Range("A" & R).Resize(1, 9).Copy

ليكون هكذا فى كل ترحيلة أى ينبغى تغييره 4 مرات فى حالة هذا الملف

Range("A" & R).Resize(1, 11).Copy

تغيير الرقم 11 يغير عدد الأعمدة التى يتم ترحيلها فى كل شيت

قام بنشر

الكود كامل بشرحه التفصيلى

علماً بأنه تم عمل معادلة فى العمود الخامس لتحديد القسم الذى سيرحل إليه الطالب حسب المواد التى سيدرسها


Sub ترحيل_أقسام()

''' متغيرات بعدد الصفحات المطلوب الترحيل اليها

Dim R As Integer, A As Integer, B As Integer, C As Integer, D As Integer

''' أسماء الصفحات المطلوب الترحيل اليها والمدى المطلوب مسح البيانات القديمة منه

Sheets("أدبى").Range("A2:DZ5000").ClearContents

Sheets("أدبى محول").Range("A2:DZ5000").ClearContents

Sheets("علمى علوم").Range("A2:DZ5000").ClearContents

Sheets("علمى رياضة").Range("A2:DZ5000").ClearContents

''' عدد الصفوف العليا في الصفحات المنقول اليها البيانات

A = 2: B = 2: C = 2: D = 2

Application.ScreenUpdating = False

''' بداية ونهاية صفوف الورقة المصدر

For R = 2 To 5000

'''''''''''''''''''''''''''''''''''''''''''''''''''

''تكرر الأسطر التالية لكل شيت يتم الترحيل فيه مع تغيير المتغيرات

''' رقم عمود المعيار وكلمة المعيار

If Cells(R, 5) = "أدبى" Then

''' عدد الأعمدة التى سيتم ترحيلها

Range("A" & R).Resize(1, 11).Copy

''' سيتم اللصق في هذا الشيت

Sheets("أدبى").Range("A" & A).PasteSpecial xlPasteValues

Application.CutCopyMode = False

A = A + 1

						 End If

If Cells(R, 5) = "أدبى محول" Then

Range("A" & R).Resize(1, 11).Copy

Sheets("أدبى محول").Range("A" & B).PasteSpecial xlPasteValues

Application.CutCopyMode = False

B = B + 1

						 End If

If Cells(R, 5) = "علمى علوم" Then

Range("A" & R).Resize(1, 11).Copy

Sheets("علمى علوم").Range("A" & C).PasteSpecial xlPasteValues

Application.CutCopyMode = False

C = C + 1

						 End If

If Cells(R, 5) = "علمى رياضة" Then

Range("A" & R).Resize(1, 11).Copy

Sheets("علمى رياضة").Range("A" & D).PasteSpecial xlPasteValues

Application.CutCopyMode = False

D = D + 1

						 End If

'If Cells(R, 4) = "5" Then

'Range("A" & R).Resize(1, 11).Copy

'Sheets("5").Range("A" & E).PasteSpecial xlPasteValues

'Application.CutCopyMode = False

'E = E + 1

'						 End If

'If Cells(R, 4) = "6" Then

'Range("A" & R).Resize(1, 11).Copy

'Sheets("6").Range("A" & F).PasteSpecial xlPasteValues

'Application.CutCopyMode = False

'F = F + 1

'						 End If

Next

		 For J = 1 To 4

				 Sheets(J).[a2] = 1

				 rrw = Sheets(J).[B3000].End(xlUp).Row

				 For Each cc In Sheets(J).Range("a3:B" & rrw)

						 cc.Value = cc.Offset(-1, 0) + 1

				 Next cc

		 Next J

MsgBox ("الحمد لله تـــم ترحيل الطلبة كل إلى قسمه")

		 For k = 1 To 4

						 y = Sheets(k).[B3000].End(xlUp).Row - 1

						 mssg = mssg & Chr(10) & Format(y, "00") & " Students to Sheet : " & k

		 Next k

MsgBox (" تم ترحيل عدد" & mssg)

		 Range("B1").Select

Application.ScreenUpdating = True

End Sub


قام بنشر

ارجو تحديد وتوضيح المشكلة

هل هى فى المعادلة ام فى الكود

الكود سليم والطلبة باللون الاحمر تم ترحيلهم لنفس اقسامهم

لو المشكلة فى المعادلة

اكمل شروط المواد ليتم تظبيط المعادلة

قام بنشر

استاذي يوسف عطا ليس هناك خطأ بالمعني المقصود ولكن لقد قمت سيادتك بتقييد كل عمود بمادة معينة ولكن هناك ملحوظة هل يمكن توسيع مدي المعادلة للمادة بمعني أن المواد الاتية لا يمكن أن تجتمع في صف واحد وهي التاريخ - رياضيات 2 - الأحياء - الجيولوجيا

قام بنشر

بص يا أستاذ

كدة يبقى المعادلة معطياتها ناقصة

إنت هاتقسم الطلبة على عدة شعب

مش كدة ؟؟

حدد أيه هى المواد إللى هتدرس فى كل شعبة وبناء عليها نعمل المعادلة التى ستحدد شعبة الطالب

ماشى ؟؟ فى إنتظار ردك للتنفيذ

قام بنشر

استاذي ومعلمي أ/ يوسف

علمي العلوم المواد الاجبارية بها الفيزياء والاحياء بالاضافة لعلم النفس او الاقتصاد

علمي الرياضيات المواد الاجبارية بها الفيزياء ورياضة 2 بالاضافة لعلم النفس او الاقتصاد

الادبي المواد الاجبارية بها الجيولوجيا والفلسفة وعلم النفس

الادبي المحول المواد الاجبارية بها التاريخ والفلسفة وعلم النفس

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

قام بنشر

تفضل المرفق أتمنى أن يفى بالغرض

تغيير مواد الطلاب فى الشيت المجمع يتم فى الأعمدة من H إلى M

وتلقائياً سيتم تغيير مواد الطلبة فى الأعمدة التى ترتبط بالمعادلات التى يعمل معها الكود

ولو فى أى تعديل آخر تريده أنا تحت أمرك

ترحيل 4 شعب.rar

قام بنشر

وهذا حل آخر عزيزى الغالى يحقق المزيد من المرونة ويكتشف الخطأ إن وجد

كما يعتمد على الإختيار من القوائم المنسدلة بدلاً من كتابة إسم المادة فيتحقق المزيد من الدقة

وبرضه لو فى أى شئ أنا تحت أمرك

ترحيل 4 شعب2.rar

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information