(تمت الاجابة) ترحيل الطلاب الناجحون فى شيت منفصل

[محمد عبد القادر]

الأخوة الأفاضل أثقلت عليكم و لكن يشفع لى كرمكم و حلمكم

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

أريد أن أفصل الطلاب الناجحون فى شيت منفصل و كذلك الراسبون و ذلك فى المدرسة و الخدمات

كنترول أولى ثانوى.rar

تم تعديل يناير 3, 2012 بواسطه hagabdelkader

[طارق محمود]

السلام عليكم

اخي العزيز

تفضل المرفق

كنترول أولى ثانوى2.rar

[احمدزمان]

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

استاذ طارق

فكرة وكود رائع

استفدت منه

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

[طارق محمود]

السلام عليكم

أخي وأستاذي أحمد يعقوب

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

منكم استفدنا الكثير

أنتم السباقون دائما

[فضل حسين]

الاستاذ / طارق

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

اكيد عمل ممتاز مثل صاحبه ولكن اصحاب اوفيس 2003 حرموا من مشاهدة هذا العمل

لذلك نرجو من استاذنا الفاضل / طارق

نسخة من الحل على اوفيس 2003

ولسيادتكم جزيل الشكر

[طارق محمود]

السلام عليكم

أخي فضل

فضلك الله

أولا لابد ان تساير العصر وتركب 2010 وليس 2007 حتي

ثانيا لمن مايزال يستخدم 2003

تفضل المرفق

أنظر قبل إجراء الكود للصفحات : من (راسب خدمات) إلي (ناجح مدرسة)

تجدها فارغة وبعد الكود يتم الترحيل عليها

فكرة الكود

يبدأ من العمود N ويقسم الحالات التي سيجدها في هذا العمود إلي حالتين

حالة: مدرسة

وحالة: خدمات

وعند كل حالة يسجل حالة العمود رقم 72 (أي العمود BT)

إن كانت راسب أو ناجح وينسخ الصف كله للشيت الذي يصف الحالة

كنترول أولى ثانوى2003-rar.rar

[فضل حسين]

استاذنا الفاضل / طارق

عمل رائع بارك الله فيك وجزاك الله عنا كل خير. وكما قلت لك عمل ممتاز من شخصية ممتازة .

ولكن يوجد ملحوظة بسيطة بعد اذن سيادتك اطرحها عليك

هل يمكن عند الضغط على زر الترحيل يظهر مربع حوارى بتمام الترحيل ولايرحل الاسماء الا مرة واحدة فقط لاغير. ولاترحل الاسماء اكثر من مرة عند الضغط على زر ترحيل .

بمعنى ان ماتم ترحيلة لايتم ترحيله مره اخرى عند الضغط على الزر . وعند الضغط على زر الترحيل مرة اخرى يرحل الجديد ولايعيد ترحيل ماتم ترحيله .

وان شاء الله هاعمل بنصيحتك وتنصيب اوفيس 2010 فى اقرب وقت

والف الف شكر لاهتمامك باصحاب اوفيس 2003

[الـعيدروس]

ماشاء الله تبارك الله

ماأروع وماأجمل التحاور السلس مع الأكواد

أستاذ طارق محمود كل يوم نتعلم منك

نسأل الله ان يوفقك دنيا واخرة

تقبل مروري

[محمد عبد القادر]

الأخ الفاضل / أشكرك على اهتمامك و مجهودك

لكن فتحت الشيت و ضغطت على زر الترحيل و لم ترحل الأسماء أو الدرجات

أعتذر مقدماً لتعبك

[طارق محمود]

السلام عليكم

أخي (حاج عبد القادر)

يبدو أن الماكرو في الإكسل لديك غير مفعل

حيث أنك أرسلت السؤال أصلا بنسخة 2007 / 2010

فيكون تفعيل الماكرو عن طريق

(1)

عند فتح الملف إذا وجدت بالأعلي عنوان (أصفر تفريبا) Enable Contents

إضغط عليه ليتيح للماكرو ان يعمل

أو

(2)

من File

Options

Trust Center

Trust Center Settings

Macro Settings

Enable all Macros (Not Recomm......)

[طارق محمود]

استاذنا الفاضل / طارق

عمل رائع بارك الله فيك وجزاك الله عنا كل خير. وكما قلت لك عمل ممتاز من شخصية ممتازة .

ولكن يوجد ملحوظة بسيطة بعد اذن سيادتك اطرحها عليك

هل يمكن عند الضغط على زر الترحيل يظهر مربع حوارى بتمام الترحيل ولايرحل الاسماء الا مرة واحدة فقط لاغير. ولاترحل الاسماء اكثر من مرة عند الضغط على زر ترحيل .

بمعنى ان ماتم ترحيلة لايتم ترحيله مره اخرى عند الضغط على الزر . وعند الضغط على زر الترحيل مرة اخرى يرحل الجديد ولايعيد ترحيل ماتم ترحيله .

وان شاء الله هاعمل بنصيحتك وتنصيب اوفيس 2010 فى اقرب وقت

والف الف شكر لاهتمامك باصحاب اوفيس 2003

السلام عليكم

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

Sub Macro1()

'

' Macro1 Macro

'

On Error Resume Next

	LR = [A10000].End(xlUp).Row

	If [FX1] < LR Then

		NS = LR - [FX1] ' عدد الطلاب الذين سيتم ترحيلهم

		SR = [FX1] + 1 ' رقم الصف الذي يبدأ منه الترحيل

		For Each ce In Range("N" & SR & ":N" & LR)

			r = ce.Row

			Select Case ce.Value

				Case "خدمات"

					If Cells(r, 72) = "ناجح" Then

						rr = Sheets("ناجح خدمات").[A1000].End(xlUp).Row + 1

						If rr < 5 Then rr = 5

						Range("A" & r & ":FN" & r).Copy (Sheets("ناجح خدمات").Range("A" & rr))

					Else:

						rr = Sheets("راسب خدمات").[A1000].End(xlUp).Row + 1

						If rr < 5 Then rr = 5

						Range("A" & r & ":FN" & r).Copy (Sheets("راسب خدمات").Range("A" & rr))


					End If

				Case "مدرسة"

					If Cells(r, 72) = "ناجح" Then

						rr = Sheets("ناجح مدرسة").[A1000].End(xlUp).Row + 1

						If rr < 5 Then rr = 5

						Range("A" & r & ":FN" & r).Copy (Sheets("ناجح مدرسة").Range("A" & rr))

					Else:

						rr = Sheets("راسب مدرسة").[A1000].End(xlUp).Row + 1

						If rr < 5 Then rr = 5

						Range("A" & r & ":FN" & r).Copy (Sheets("راسب مدرسة").Range("A" & rr))


					End If

			End Select

		Next ce

		MsgBox ("تم ترحيل عدد " & NS & " طلاب" & Chr(10) & "الحمد لله")

	Else

		MsgBox ("تم ترحيل هؤلاء الطلاب من قبل..." & Chr(10) & "لم يتم الترحيل")

	End If

	[FX1] = LR

	End Sub

أو تفضل المرفق

كنترول أولى ثانوى3.rar

[محمد عبد القادر]

اللهم إنى فقير لا أملك ما أكافئ به عبدك و أنت الغنى الكريم فاللهم كافئه من واسع كرمك

[محمد عبد القادر]

الأخ الفاضل

و الله إنى لأستحيى من ازعاجك و لكن لم أجد عوناً من الآخرين فأضررت لسؤالك ثانية

هل يمكن عمل هذه العملية بالمعادلات بدلا من الأكواد

وسلفاً لكم وافر التقدير

[طارق محمود]

السلام عليكم

أخي العزيز

مرفق نفس المطلوب بالمعادلات

مع ملاحظة اني لجأت لعمودين مساعدين في ورقة الرصد وعمود مساعد في كل من ورقات خدمات ناجح ، خدمات راسب، مدرسة راسب ، مدرسة ناجح

وكذلك أضفت شرط جديد في التنسيق الشرطي يجعل الفونط ابيض والخلية بيضاء غذا كان ناتج المعادلة خطأ

تفضل المرفق

كنترول أولى ثانوى4.rar

[محمد عبد القادر]

لست أدرى كيف أشكرك

يسر الله لك أحوال الدنيا و الآخرة كما يسرت علىً أخى الحبيب جزاكم الله الخير كله

تم تعديل يناير 7, 2012 بواسطه hagabdelkader