احتاج كود ت رحيل من اساتذتي

degabro · يونيو 6, 2011

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

احتاج الي عمل كود ترحيل علي شيت aa وشيت bb بحيث انه عند كتابة بيانات في شيت aa وهو الخاص بالمحولين الي المدرسة يتم اضافة البيان الجديد الي مكانة الصحيح في الشيت الخاص به اي عندما تكون البيانات لطالب في الصف الخامس يتم ترحيل بياناته الي الشيت الخاص بالصف الخامس وهو 5 وهكذا

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

مع مراعاة عدم تأثر اي معادلات موجودة بالشيت المرحل اليه

ارجو الافادة اساتذتي

Book1.zip

degabro · يونيو 7, 2011

في انتظاركم يا اخواني؟

degabro · يونيو 7, 2011

يارب الرد ما يتأخرشي ؟

degabro · يونيو 7, 2011

ارب ماتكونوش نمتوا

degabro · يونيو 7, 2011

لما لم تجيبوني ايها الزملاء الأفاضل

هل سؤالي واستفساري بالصعوبة؟

**طارق محمود** · يونيو 8, 2011

السلام عليكم

أخي العزيز

هذا الكود للمحولين إلي المدرسة


Sub ToSchool()

'

' Macro1 Macro

'


Lst_R = [B1000].End(xlUp).Row

For r = 12 To Lst_R

	cls = Cells(r, 3)

	For w = 1 To Worksheets.Count

    	a = Format(cls, "0")

    	If Sheets(w).Name = a Then

        	Range("B" & r & ":R" & r).Copy

        	new_R = Sheets(a).[B1000].End(xlUp).Row + 1

        	Sheets(a).Range("B" & new_R).PasteSpecial Paste:=xlPasteValues

        	Sheets(a).Range("A" & new_R).Value = Sheets(a).Range("A" & new_R - 1).Value + 1

        	Range("A" & r & ":R" & r).ClearContents

        	Application.CutCopyMode = False

        	GoTo 10

    	End If

 	Next w

' No sheets named this Class

	MsgBox ("No Class =" & cls)

	Exit Sub


10      	' exit FOR w



Next r



End Sub

وهذا للمحولين من المدرسة

Sub FromSchool()

'

' Macro1 Macro

'


Lst_R = [B1000].End(xlUp).Row

For r = 12 To Lst_R

	cls = Cells(r, 3)

	kid = Cells(r, 2)

	For w = 1 To Worksheets.Count

    	a = Format(cls, "0")

    	If Sheets(w).Name = a Then

       	' Range("B" & r & ":R" & r).Copy

        	new_R = Sheets(a).[B1000].End(xlUp).Row

            	For i = 11 To new_R

                	kkid = Sheets(a).Cells(i, 2)

                	If kkid = kid Then GoTo 15

            	Next i

            	' Not found the KID's name in this Class

            	MsgBox ("No KID's named " & Chr(10) & kid & Chr(10) & "in Class " & a)

            	Exit Sub


15      	' found the KID - exit FOR i (keep the Row number of Kid in i)

        	Sheets(a).Range("B" & i + 1 & ":R" & new_R + 1).Copy

        	Sheets(a).Range("B" & i).PasteSpecial Paste:=xlPasteValues

        	Sheets(a).Range("A" & new_R).ClearContents

        	Range("A" & r & ":R" & r).ClearContents

        	GoTo 10

    	End If

 	Next w

' No sheets named this Class

	MsgBox ("No Class =" & a)

	Exit Sub


10      	' exit FOR w

        	Application.CutCopyMode = False


Next r



End Sub

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

المحولين.rar

**طارق محمود** · يونيو 8, 2011

فقط للتذكير

ارب ماتكونوش نمتوا

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

اضغط هنـــــــــامن فضلك لقراء القواعد كاملة

و بصفة خاصة نؤكدعلى ما يلي

1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة

2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد.

3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال.

4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا.....

5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم.

ومخالفة ذلك تعرض الموضوع للحذف

degabro · يونيو 8, 2011

اخي العزيز TareQ M

أأسف بشدة علي جملتي التي قلتها في التعليق السابق

ولكن هذا من قبيل العشم كما يقولون

ونظرا لأني كنت في امس الحاجة لهذا الموضوع

ولا انكر افضال هذا المنتدي علي وكذلك اعضاءه

واكرر اسفي اخي العزيز

degabro · يونيو 8, 2011

واشكرك اهخي العزيز علي مجهودك الرائع في مساعدتي

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

degabro · يونيو 8, 2011

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

**طارق محمود** · يونيو 8, 2011

أخي الفاضل

إرسل الشيت بالمعادلات

degabro · يونيو 8, 2011

الشيت كما طلبت يا اخي العزيز

والمعادلات في اعمدة السن في 1/10/2001

وكذلك في عمود اسم ولي الامر

المحولين.zip

**ياسر الحافظ** · يونيو 8, 2011

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

على مايبدو نحن محكومين بأن نقول دائما لحضرتك شكرا.... شكرا

والله روعة

وفقك الله

ياسر الحافظ

**طارق محمود** · يونيو 8, 2011

السلام عليكم

أخي ديجابرو

إستبدل الكود بالتالي

سنقسم عملية النسخ واللصق ثلاث مقاطع لتلافي الخلايا التي بها معادلات


Sub ToSchool()

'

' Macro1 Macro

'


Lst_R = [B1000].End(xlUp).Row

For r = 12 To Lst_R

	cls = Cells(r, 3)

	For w = 1 To Worksheets.Count

    	a = Format(cls, "0")

    	If Sheets(w).Name = a Then

        	Range("B" & r & ":I" & r).Copy

        	new_R = Sheets(a).[B1000].End(xlUp).Row + 1

        	Sheets(a).Range("B" & new_R).PasteSpecial Paste:=xlPasteValues

        	Range("M" & r & ":N" & r).Copy

        	Sheets(a).Range("M" & new_R).PasteSpecial Paste:=xlPasteValues

        	Range("P" & r & ":R" & r).Copy

        	Sheets(a).Range("P" & new_R).PasteSpecial Paste:=xlPasteValues


        	Sheets(a).Range("A" & new_R).Value = Sheets(a).Range("A" & new_R - 1).Value + 1

        	Range("A" & r & ":I" & r).ClearContents

        	Range("M" & r & ":N" & r).ClearContents

        	Range("P" & r & ":R" & r).ClearContents

        	Application.CutCopyMode = False

        	GoTo 10

    	End If

 	Next w

' No sheets named this Class

	MsgBox ("No Class =" & cls)

	Exit Sub


10      	' exit FOR w



Next r



End Sub


Sub FromSchool()

'

' Macro1 Macro

'


Lst_R = [B1000].End(xlUp).Row

For r = 12 To Lst_R

	cls = Cells(r, 3)

	kid = Cells(r, 2)

	For w = 1 To Worksheets.Count

    	a = Format(cls, "0")

    	If Sheets(w).Name = a Then

       	' Range("B" & r & ":R" & r).Copy

        	new_R = Sheets(a).[B1000].End(xlUp).Row

            	For i = 11 To new_R

                	kkid = Sheets(a).Cells(i, 2)

                	If kkid = kid Then GoTo 15

            	Next i

            	' Not found the KID's name in this Class

            	MsgBox ("No KID's named " & Chr(10) & kid & Chr(10) & "in Class " & a)

            	Exit Sub


15      	' found the KID - exit FOR i (keep the Row number of Kid in i)

        	Sheets(a).Range("B" & i + 1 & ":I" & new_R + 1).Copy

        	Sheets(a).Range("B" & i).PasteSpecial Paste:=xlPasteValues


        	Sheets(a).Range("M" & i + 1 & ":N" & new_R + 1).Copy

        	Sheets(a).Range("M" & i).PasteSpecial Paste:=xlPasteValues


        	Sheets(a).Range("P" & i + 1 & ":R" & new_R + 1).Copy

        	Sheets(a).Range("P" & i).PasteSpecial Paste:=xlPasteValues


        	Sheets(a).Range("A" & new_R).ClearContents

       	Range("A" & r & ":I" & r).ClearContents

        	Range("M" & r & ":N" & r).ClearContents

        	Range("P" & r & ":R" & r).ClearContents

        	GoTo 10

    	End If

 	Next w

' No sheets named this Class

	MsgBox ("No Class =" & a)

	Exit Sub


10      	' exit FOR w

        	Application.CutCopyMode = False


Next r



End Sub

**طارق محمود** · يونيو 8, 2011

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

على مايبدو نحن محكومين بأن نقول دائما لحضرتك شكرا.... شكرا

والله روعة

وفقك الله

ياسر الحافظ

الأخ العزيز علي الروح القريب من القلب / ياسر الحافظ

اللهم أعز سوريا وأهلها

وسائر بلاد المسلمين

أخي الكريم ،

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

تقبل ودي واحترامي

أخوكم طارق محمود (أبو زياد)

تم تعديل يونيو 9, 2011 بواسطه TareQ M

degabro · يونيو 8, 2011

بارك الله فيك يا اخي العزيز وافادنا دائما بعلمك الغزير

ورزقك رزقا خلالا طيبا مباركا وبارك لك في زريتك

تسجيل الدخول

احتاج كود ت رحيل من اساتذتي

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

degabro

degabro

degabro

degabro

degabro

طارق محمود

طارق محمود

degabro

degabro

degabro

طارق محمود

degabro

ياسر الحافظ

طارق محمود

طارق محمود

degabro

Join the conversation

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

تصفح الموقع

تصفح جديد الموقع

Support

Important Information