عبدالسلام علي قام بنشر سبتمبر 9, 2016 قام بنشر سبتمبر 9, 2016 Sub ali_Fail_Students() Sheets("الناجحون").Range("a6:aq100") = "" Sheets("الناجحون").Range("a6:aq100").Interior.ColorIndex = 0 Application.ScreenUpdating = False X = Sheets("تجميعي").[e1000].End(xlUp).Row For T = 11 To X Step 3 Y = Sheets("الناجحون").[A1000].End(xlUp).Row + 1 If Sheets("تجميعي").Range("au" & T).Value = "ناجح" Then Sheets("الناجحون").Range("a" & Y) = Sheets("تجميعي").Range("E" & T).Value Sheets("الناجحون").Range("d" & Y) = Sheets("تجميعي").Range("g" & T).Value Sheets("الناجحون").Range("c" & Y) = Sheets("تجميعي").Range("f" & T).Value Sheets("الناجحون").Range("e" & Y & ":aq" & Y) = Sheets("تجميعي").Range("j" & T + 2 & ":av" & T + 2).Value Else End If Next Clear_and_Highlight Application.ScreenUpdating = True End Sub Sub rakan_Fail_Students() Sheets("راسب").Range("a6:aq100") = "" Sheets("راسب").Range("a6:aq100").Interior.ColorIndex = 0 Application.ScreenUpdating = False X = Sheets("تجميعي").[e1000].End(xlUp).Row For T = 11 To X Step 3 Y = Sheets("راسب").[A1000].End(xlUp).Row + 1 If Sheets("تجميعي").Range("au" & T).Value = "له دور ثان فى" Then Sheets("راسب").Range("a" & Y) = Sheets("تجميعي").Range("E" & T).Value Sheets("راسب").Range("d" & Y) = Sheets("تجميعي").Range("g" & T).Value Sheets("راسب").Range("c" & Y) = Sheets("تجميعي").Range("f" & T).Value Sheets("راسب").Range("e" & Y & ":aq" & Y) = Sheets("تجميعي").Range("j" & T + 2 & ":av" & T + 2).Value Else End If Next Clear_and_Highlight Application.ScreenUpdating = True End Sub هذين الكودين للترحيل يعملان كلا على حدى اي زر لترحيل الناجحين وزر لترحيل الراسبين المطلوب رب هذين الكودين بزر واحد يقوم بترحيل الناجحين والراسبين دفعة واحدة
ياسر خليل أبو البراء قام بنشر سبتمبر 9, 2016 قام بنشر سبتمبر 9, 2016 أخي الكريم يرجى إرفاق ملف لتتضح صورة طلبك ولتجد استجابة أفضل في الموضوع كما يرجى ذكر المطلوب بالتفصيل .. لا يجب الشرح بشكل عام تحدث بلغة الإكسيل كأن تقول في ورقة كذا والخلية كذا والنطاق كذا .. إذا كان الكودان يعملان بشكل جيد فيمكنك أن تتركهما كما هما وتنشيء إجراء فرعي جديد وتعمل استدعاء لكل منهم على حدا باستخدام كلمة Call يليها اسم الإجراء الفرعي أو كتابة اسم الإجراء الفرعي بشكل مباشر Sub Test() Call ali_Fail_Students Call rakan_Fail_Students End Sub
عبدالسلام علي قام بنشر سبتمبر 9, 2016 الكاتب قام بنشر سبتمبر 9, 2016 اشكرك استاذي الفاضل ياسر اولا :- لعدم رفع الملف كبير الحجم لم استطع رفعه وثانيا :- الكود الذي كتبته هذا ما اريده فعلا وجزاك الله كل خير وفي ميزان حسناتك 1
ياسر خليل أبو البراء قام بنشر سبتمبر 10, 2016 قام بنشر سبتمبر 10, 2016 الحمد لله الذي بنعمته تتم الصالحات والحمد لله أن تم المطلوب على خير تقبل تحياتي وكل عام وأنت بخير 1
قلم-الاكسل(عبدالعزيز) قام بنشر سبتمبر 10, 2016 قام بنشر سبتمبر 10, 2016 رائع كالعادة المهندس ياسر جاوبت باقل مجهود فكان المطلوب باركك الله 1
ابو عبدالبارى قام بنشر سبتمبر 10, 2016 قام بنشر سبتمبر 10, 2016 23 ساعات مضت, عبدالسلام علي said: Sub ali_Fail_Students() Sheets("الناجحون").Range("a6:aq100") = "" Sheets("الناجحون").Range("a6:aq100").Interior.ColorIndex = 0 Application.ScreenUpdating = False X = Sheets("تجميعي").[e1000].End(xlUp).Row For T = 11 To X Step 3 Y = Sheets("الناجحون").[A1000].End(xlUp).Row + 1 If Sheets("تجميعي").Range("au" & T).Value = "ناجح" Then Sheets("الناجحون").Range("a" & Y) = Sheets("تجميعي").Range("E" & T).Value Sheets("الناجحون").Range("d" & Y) = Sheets("تجميعي").Range("g" & T).Value Sheets("الناجحون").Range("c" & Y) = Sheets("تجميعي").Range("f" & T).Value Sheets("الناجحون").Range("e" & Y & ":aq" & Y) = Sheets("تجميعي").Range("j" & T + 2 & ":av" & T + 2).Value Else End If Next Clear_and_Highlight Application.ScreenUpdating = True End Sub Sub rakan_Fail_Students() Sheets("راسب").Range("a6:aq100") = "" Sheets("راسب").Range("a6:aq100").Interior.ColorIndex = 0 Application.ScreenUpdating = False X = Sheets("تجميعي").[e1000].End(xlUp).Row For T = 11 To X Step 3 Y = Sheets("راسب").[A1000].End(xlUp).Row + 1 If Sheets("تجميعي").Range("au" & T).Value = "له دور ثان فى" Then Sheets("راسب").Range("a" & Y) = Sheets("تجميعي").Range("E" & T).Value Sheets("راسب").Range("d" & Y) = Sheets("تجميعي").Range("g" & T).Value Sheets("راسب").Range("c" & Y) = Sheets("تجميعي").Range("f" & T).Value Sheets("راسب").Range("e" & Y & ":aq" & Y) = Sheets("تجميعي").Range("j" & T + 2 & ":av" & T + 2).Value Else End If Next Clear_and_Highlight Application.ScreenUpdating = True End Sub هذين الكودين للترحيل يعملان كلا على حدى اي زر لترحيل الناجحين وزر لترحيل الراسبين المطلوب رب هذين الكودين بزر واحد يقوم بترحيل الناجحين والراسبين دفعة واحدة الأخ العزيز عبدالسلام علي السلام عليكم جرب هذا الكود بعد دمجة لعلة يكون المطلويب باذن الله نسألكم الدعاء Sub abo_abary() Sheets("ÇáäÇÌÍæä").Range("a6:aq100") = "" Sheets("ÇáäÇÌÍæä").Range("a6:aq100").Interior.ColorIndex = 0 Sheets("ÑÇÓÈ").Range("a6:aq100") = "" Sheets("ÑÇÓÈ").Range("a6:aq100").Interior.ColorIndex = 0 Application.ScreenUpdating = False X = Sheets("ÊÌãíÚí").[e1000].End(xlUp).Row For T = 11 To X Step 3 Y = Sheets("ÇáäÇÌÍæä").[A1000].End(xlUp).Row + 1 If Sheets("ÊÌãíÚí").Range("au" & T).Value = "äÇÌÍ" Then Sheets("ÇáäÇÌÍæä").Range("a" & Y) = Sheets("ÊÌãíÚí").Range("E" & T).Value Sheets("ÇáäÇÌÍæä").Range("d" & Y) = Sheets("ÊÌãíÚí").Range("g" & T).Value Sheets("ÇáäÇÌÍæä").Range("c" & Y) = Sheets("ÊÌãíÚí").Range("f" & T).Value Sheets("ÇáäÇÌÍæä").Range("e" & Y & ":aq" & Y) = Sheets("ÊÌãíÚí").Range("j" & T + 2 & ":av" & T + 2).Value ElseIf Sheets("ÊÌãíÚí").Range("au" & T).Value = "áå ÏæÑ ËÇä Ýì" Then Sheets("ÑÇÓÈ").Range("a" & Y) = Sheets("ÊÌãíÚí").Range("E" & T).Value Sheets("ÑÇÓÈ").Range("d" & Y) = Sheets("ÊÌãíÚí").Range("g" & T).Value Sheets("ÑÇÓÈ").Range("c" & Y) = Sheets("ÊÌãíÚí").Range("f" & T).Value Sheets("ÑÇÓÈ").Range("e" & Y & ":aq" & Y) = Sheets("ÊÌãíÚí").Range("j" & T + 2 & ":av" & T + 2).Value End If Next Clear_and_Highlight Application.ScreenUpdating = True End Sub 1
عبدالسلام علي قام بنشر سبتمبر 11, 2016 الكاتب قام بنشر سبتمبر 11, 2016 السلام عليكم اخي ابو عبدالباري كل العام وانت بالف خير واشكر اهتمامك
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.