شرح كود الترحيل الراسب والناجح

[رامى الشاذلى]

احبائي الكرام عاوز شرح لكود الترحيل الناجح فى شيت والراسب فى شيت 

بس انا عاوز شرح للكود نفسة 

اى خطوة بخطوة 

 

[قنديل الصياد]

الاخ العزيز

مرفق شرح لكود فصل الناجحين والراسبين للاستاذ الفاضل / رجب جاويش عافاه الله وشفاه

 

شرح كود فصل الناجحين والراسبين1.rar

[قنديل الصياد]

ويمكن ايضا ان تتابع هذا الرابط

 

http://www.officena.net/ib/index.php?showtopic=41845

[قنديل الصياد]

بداية الكود
                                 Sub Tarheel()
السطور التالية خاصة بتعيين متغيرات لتخزين البيانات من نوع أرقام صحيحة Integer
Dim i As Integer, x As Integer
Dim lr As Integer, y As Integer

السطر التالى لتحديد اخر صف يحتوى على بيانات 
                               lr = [b10000].End(xlUp).Row

السطرين التاليين لمسح بيانات صفحة ناجحون وراسبون قبل نسخ البيانات اليهما 
Sheets("ناجحون").Range("a9:ho1000").ClearContents
Sheets("راسبون").Range("a9:ho1000").ClearContents

السطر التالى يعمل على ايقاف اهتزاز الشاشة ( لتسريع الكود ) 
Application.ScreenUpdating = False

السطر التالى يعطى قيمة للمتغيرين x   و  y   وهى تساوى 9 ( أول صف يتم فيه لصق البيانات المنسوخة فى صفحة ( ناجحون ) وصفحة (  راسبون )
x = 9: y = 9


السطر التالى بداية حلقة تكرارية تبدأ من الصف التاسع الى lr  ( اخر صف يحتوى على بيانات  )
                              For i = 9 To lr

وتنتهى هذه الحلقة التكرارية بالكلمة next 

السطر التالى يختبر قيمة الخلية المحتوية على نتيجة الطالب 

                          If Cells(i, 3).Value = "ناجح" And Cells(i, 4) <> " " Then
فاذا كانت تحتوى على كلمة ناجح وخلية اسم الطالب ليست فارغة  يقوم بنسخ الصف بالكامل الذى توجد فيه الخلية  عن طريق السطر التالى 
                          Range("a" & i).Resize(1, 223).Copy
السطر التالى يعمل على لصق البيانات المنسوخة الى الصفحة ( ناجحون ) 
                         Sheets("ناجحون").Range("a" & x).PasteSpecial xlPasteValues 
السطر التالى يعمل على ايقاف خاصية النسخ واللصق 
                        Application.CutCopyMode = False
السطر التالى يزيد قيمة المتغير  x  بمقدار واحد 
                        x = x + 1
  الجزء الباقى من الكود تكرار الخطوات السابقة ولكن مع الراسب 
السطر التالى خاص باظهار رسالة توضح اكتمال عملية فصل الناجحون والراسبون 
MsgBox "تم بحمد الله فصل الناجحين والراسبين فى كشوف منفصلة", vbOKOnly, "ترحيل الناجحون والراسبون"

السطر التالى يعيد مرة اخرى خاصية اهتزاز الشاشة 
             Application.ScreenUpdating = True
نهاية الكود
            End Sub
الشرح لاخيكم
/ رجب جاويش

تم تعديل نوفمبر 22, 2013 بواسطه قنديل الصياد

[رامى الشاذلى]

الله عليك 

هو ده اللى انا بدور عليه الف مليون شكر 

وشكر لاستاذ رجب 

علمنى الصيد ولا تعطنى سمكة 

[رامى الشاذلى]

ويمكن ايضا ان تتابع هذا الرابط

 

http://www.officena.net/ib/index.php?showtopic=41845

الف مليون شكر 

[قنديل الصياد]

[رامى الشاذلى]

 استاذنا / قنديل الصياد جيت أجرب ما اشتغل مش عارف ليه 

على العموم هذا الشيت اللى انا شغال علية ممكن تغيرة 

عاوز  أعمل الراسب والناجح 

كلا منهما فى شيت 

والعشرة الاوائل 

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

[رامى الشاذلى]

 استاذنا / قنديل الصياد جيت أجرب ما اشتغل مش عارف ليه 

على العموم هذا الشيت اللى انا شغال علية ممكن تغيرة 

عاوز  أعمل الراسب والناجح 

كلا منهما فى شيت 

والعشرة الاوائل 

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

 

 

rami.rar

[قنديل الصياد]

 استاذنا / قنديل الصياد جيت أجرب ما اشتغل مش عارف ليه 

على العموم هذا الشيت اللى انا شغال علية ممكن تغيرة 

عاوز  أعمل الراسب والناجح 

كلا منهما فى شيت 

والعشرة الاوائل 

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

اخى العزيز وجدت لك كنترول شيت للمدارس الصناعية رائع يمكن ان تحمله من هنا

ولو اردت الشيت الخاص بك ساقوم على تنفيذه كما تريد ولكنى رايت ان الشيت على الرابط افضل بكثير

 

 

http://www.thanwya.com/vb/showthread.php?t=553037

[قنديل الصياد]

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

 

تحياتى

[رامى الشاذلى]

جارى التحميل 

[قنديل الصياد]

جارى التحميل 

بالتوفيق ان شاء الله

[رامى الشاذلى]

 شكرا استاذنا الكريم على هذا الموضوع 

ربنا يجعلك من النافعين للعلم   

[قنديل الصياد]

[shetos77]

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

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

 If Cells(i, 3).Value = "ناجح" And Cells(i, 4) <> " " Then

[احمد بدره]

عليك السلام

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

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

 Sub Tarheel()
 
'السطور التالية خاصة بتعيين متغيرات لتخزين البيانات من نوع أرقام صحيحة Integer
Dim i As Integer, x As Integer
Dim lr As Integer, y As Integer
'السطر التالى يعمل على ايقاف اهتزاز الشاشة ( لتسريع الكود )
Application.ScreenUpdating = False
 'السطر التالي للذهاب لورقة العمل المسماه الشييت
 Sheets("الشييت").Activate
'السطر التالى لتحديد اخر صف يحتوى على بيانات
                               lr = [b10000].End(xlUp).Row

'السطرين التاليين لمسح بيانات صفحة ناجحون وراسبون قبل نسخ البيانات اليهما
Sheets("النتيجة").Range("a9:ho1000").ClearContents

 

'السطر التالى يعطى قيمة للمتغيرين x   و  y   وهى تساوى 9 ( أول صف يتم فيه لصق البيانات المنسوخة فى صفحة ( ناجحون ) وصفحة (  راسبون )
x = 9: y = 9

'السطر التالى بداية حلقة تكرارية تبدأ من الصف التاسع الى lr  ( اخر صف يحتوى على بيانات  )
                              For i = 9 To lr

'وتنتهى هذه الحلقة التكرارية بالكلمة next
'Print
'السطر التالى يختبر قيمة الخلية المحتوية على نتيجة الطالب
'
                         If Cells(i, 3).Value = "ناجح" Or Cells(i, 3).Value = "ناجح" And Cells(i, 4) <> " " Then
'فاذا كانت تحتوى على كلمة ناجح وخلية اسم الطالب ليست فارغة  يقوم بنسخ الصف بالكامل الذى توجد فيه الخلية  عن طريق السطر التالى
                          Range("a" & i).Resize(1, 223).Copy
'السطر التالى يعمل على لصق البيانات المنسوخة الى الصفحة ( ناجحون )
                         Sheets("النتيجة").Range("a" & x).PasteSpecial xlPasteValues
'السطر التالى يعمل على ايقاف خاصية النسخ واللصق
                        Application.CutCopyMode = False

'  الجزء الباقى من الكود تكرار الخطوات السابقة ولكن مع الراسب
'السطر التالى خاص باظهار رسالة توضح اكتمال عملية فصل الناجحون والراسبون
MsgBox "تم بحمد الله فصل الناجحين والراسبين فى كشوف منفصلة", vbOKOnly, "ترحيل الناجحون والراسبون"

'السطر التالى يعيد مرة اخرى خاصية اهتزاز الشاشة
             Application.ScreenUpdating = True
نهاية الكود
            End Sub

وأكرر أنه لابد من إرفاق ملف به المطلوب