اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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


alliiia
إذهب إلى أفضل إجابة Solved by ابراهيم الحداد,

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

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

كنت منذ زمن حملت ملف لدرجات الطلاب

وقد أجريت عليه تعديلات يسيرة.

أرجو المساعدة في إخراج هذا الملف بصورة جميلة وكلي ثقة بإبداعاتكم.

 

المطلوب:

تعديل الكود بحيث يرحل الناجحين إلى شيت: (ناجح) 

والذين عليهم الدور ثاني، إلى شيت: (دور ثاني) 

ولو في مجال ترحيل كذلك العشر الأوائل إلى الشيت المسمى بنفس الاسم

وكذلك تعديل على شيت الإحصائية، وكذلك ترحيل الغائبين عن الاختبار إلى شيت الغائبين.

 

 

 

كشوفات الناجحين والراسبين - فصل واحد.xlsm

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

  • أفضل إجابة

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

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

اذا شعرت ان تنفيذ الكود يستغرق وقتا طويلا

يمكنك طلب عمل كود جديد يعتمد على المصفوفات و لكن لضيق الوقت 

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

اما باقى المطلوبات فى وقت لاحق ان شاء الله

اليك الكود و يجب ربطه بزر لتنفيذه فى اى وقت

Sub Tarheel()

Dim R As Integer, M As Integer, N As Integer
Sheets("ناجح").Range("A11:Q1012").Clear
Sheets("دور ثانى").Range("A11:R1012").Clear
      M = 10: N = 10
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
             For R = 11 To 1012
              If Cells(R, 14) = "ناجح" Then
                 M = M + 1
     Range("A" & R).Range("A1:Q1").Copy
             With Sheets("ناجح")
             .Range("A" & M).PasteSpecial xlPasteValues
             .Range("A" & M).PasteSpecial xlPasteFormats
             .Range("A" & M).Value = M - 10

              End With
             Application.CutCopyMode = False
                 ElseIf Cells(R, 14) = "دور ثانى" Then
                   N = N + 2
     Range("A" & R).Range("A1:R1").Copy
     With Sheets("دور ثانى")
           .Range("A" & N).PasteSpecial xlPasteValues
           .Range("A" & N).PasteSpecial xlPasteFormats
           .Range("A" & N).Value = (N - 10) / 2
             End With
             Application.CutCopyMode = False
             End If
    Next
   MsgBox ("  بحمد الله تم ترحيل الناجحين والدور الثانى")
   Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub


 

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

أجريت بعض التعديلات على الملف، وبقي فقط ترحيل الغائبين إلى شيت الغائبين، أرجو المساعدة في ذلك، ولو يوجد أحد يساعدنا في تسريع الكود؛ لأنه بطيء والله الموفق.

كشوفات الناجحين والراسبي- Copy.xlsm

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

  • 3 weeks later...
زائر
هذا الموضوع مغلق.
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

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

Important Information