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

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


إذهب إلى أفضل إجابة Solved by رامى الشاذلى,

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

الاخ العزيز

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

 

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

  • Like 1
رابط هذا التعليق
شارك

بداية الكود
                                 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
الشرح لاخيكم
/ رجب جاويش
تم تعديل بواسطه قنديل الصياد
رابط هذا التعليق
شارك

  • أفضل إجابة

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

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

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

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

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

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

رابط هذا التعليق
شارك

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

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

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

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

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

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

 

 

rami.rar

رابط هذا التعليق
شارك

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

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

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

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

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

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

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

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

 

 

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

رابط هذا التعليق
شارك

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

 

تحياتى

رابط هذا التعليق
شارك

  • 5 years later...

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

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

 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

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

رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



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

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

Important Information