ترحيل

[أبو محمد عاطف]

 لو تكرمكم حد يعمل لي هذا الموضوع جزاكم الله خيرا نبدأ نشرح المطلوب :- علي الشمال في الرئيسية شيت آخر العامA3  ندخل فيه هتلاقي "ترحيل لرصد الدور الثاني" عايز الترحيل لرصد الدور الثاني ومن "رصد الدور الثاني" تحت علي اليمين ندخل فيها هتلاقي "ترحيل الناجحين"" وترحيل الراسبين" ممكن أحد الأخوة المشاركين يتفضل مشكورا ويعملي هذا العمل لو سمحتم ورابط الملف هنا http://up.top4top.net/downloadf-410qkg1h1-rar.html

[الشهابي]

أخي العزيز / أبو محمد عاطف

ضع هذا الكود في موديول لترحيل الدور الثاني وأربطه  بزر  ( ترحيل لرصد دور الثاني ) في ورقة ( شيت آخر العام A3 )

إذا كان الأمر كذلك سنكمل ترحيل الناحجين والراسبين 

إذا كان هناك تعديل أو خطأ قم بالإشارة إليه حتى يتم التعديل والتصحيح إن شاء الله 

Sub ترحيل()
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
  Dim LR, y As Integer
Sheets("رصد الدور الثاني").Range("A13:AG1000").ClearContents
LR = Range("c10000").End(xlUp).Row
y = 13
For i = 13 To LR
   
     If Cells(i, 33).Value = "دور ثان في" And Cells(i, 3) <> 0 Then
        Range("a" & i).Resize(1, 33).Copy
        Sheets("رصد الدور الثاني").Range("a" & y).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        y = y + 1
       
      End If
Next i

  With Sheets("رصد الدور الثاني").Range("a13:a1000")
  .FormulaR1C1 = "=IF(RC[2]=0,"""",SUBTOTAL(3,R13C3:RC[2]))"
  .Value = .Value
  End With
   Sheets("رصد الدور الثاني").Activate
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

 

[أبو محمد عاطف]

جزاك الله خيرا أنا فقط كنت أريد من أحد الأخوة المشاركين أن يفعل لي هذا الأمر لأن أنا لا أفهم في عملية الترحيل وممكن نتواصل علي الفيس إذا أردت ذلك https://www.facebook.com/profile.php?id=100002775428113

تم تعديل فبراير 15, 2017 بواسطه أبو محمد عاطف

[محمود_الشريف]

أخى الحبيب

الأستاذ / الشهابي

بوركتم وجزيتم خير الخير

=============

الأستاذ / ابو محمد عاطف

بالنسبة لصفحة الدور الثانى ، الزرين ( ناجح وراسب ) على أى اساس يتم الترحيل حتى يتم عمل اللازم

تجد بالمرفقات الملف مطبق به كود الأستاذ الحبيب / الشهابي ،، فيما يختص بالترحيل لصفحة الدور الثاني

الصف الأول الابتدائي .rar

[ياسر خليل أبو البراء]

السلام عليكم

هذا موضوع قد يفيد الجميع بخصوص الطلبات المرتبطة بمثل هذا الأمر

رابط الموضوع من هنا

[أبو محمد عاطف]

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

7 دقائق مضت, ياسر خليل أبو البراء said:

السلام عليكم

هذا موضوع قد يفيد الجميع بخصوص الطلبات المرتبطة بمثل هذا الأمر

رابط الموضوع من هنا

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

[ياسر خليل أبو البراء]

شاهد الفيديو على الرابط التالي
https://www.youtube.com/watch?v=lcu5rsRgndI&t=3s

[أبو محمد عاطف]

تمام وصلت المعلومة جزاك الله خيرا .... صفحة حضرتك علي الفيس اسمها ايه ؟؟؟  لو تسمح لي 

[الشهابي]

أخي العزيز / أبو محمد عاطف

أولا جزاء الله خير الأستاذين القديرين محمود الشريف وياسر خليل خير الجزاء على مشاركتهم لنا في الموضوع

ثانياً : ما فهمته من الصورة أنك تريد عند ترحيل الدور الثاني ترك سطر فارغ فوق كل طالب 

اقتباس

لكن الذي أقصده هو ترحيل درجة الدور الثاني فقط وليس فصل أول وفصل ثان ومجموع أنا أريد ترحيل المجموع فقط مثل هذه الصورة 

 

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

Sub ترحيل()
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
  Dim LR, y As Integer
Sheets("رصد الدور الثاني").Range("A13:AG1000").ClearContents
LR = Range("c10000").End(xlUp).Row
y = 14
For i = 13 To LR
   
     If Cells(i, 33).Value = "دور ثان في" And Cells(i, 3) <> 0 Then
        Range("a" & i).Resize(1, 33).Copy
        Sheets("رصد الدور الثاني").Range("a" & y).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        y = y + 2
       
      End If
Next i

  With Sheets("رصد الدور الثاني").Range("a13:a1000")
  .FormulaR1C1 = "=IF(RC[2]=0,"""",SUBTOTAL(3,R13C3:RC[2]))"
  .Value = .Value
  End With
   Sheets("رصد الدور الثاني").Activate
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

إذا كان تريد ترحيل بآلية أخرى ممكن توضيحها 

وبالنسبة لترحيل الناجحين والراسبين من ورقة الدور الثاني ممكن توضيح آلية الترحيل 

 

تم تعديل فبراير 15, 2017 بواسطه الشهابي

[أبو محمد عاطف]

في ١٥‏/٢‏/٢٠١٧ at 21:11, الشهابي said:

 

أعتذر لك استاذنا الفاضل " الشهابي " أنا أريد الترحيل مثل ما في الصورة دي الجديدة 

 

[الشهابي]

أخي العزيز / أبو محمد عاطف

جرب التعديل التالي 

Sub ترحيل()

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
  Dim LR, y As Integer

Sheets("رصد الدور الثاني").Range("A13:AG1000").ClearContents
LR = Range("c10000").End(xlUp).Row


y = 14
For i = 13 To LR
   
    If Cells(i, 33).Value = "دور ثان في" And Cells(i, 3) <> 0 Then
        Range("a" & i).Resize(1, 33).Copy
        Sheets("رصد الدور الثاني").Range("a" & y).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        Sheets("رصد الدور الثاني").Range("ag" & y - 1).FormulaR1C1 = _
        "=IF(AND(RC[-24]>=R12C9,RC[-21]>=R12C12,RC[-18]>=R12C15,RC[-15]>=R12C18,RC[-12]>=R12C21,RC[-9]>=R12C24,RC[-6]>=R12C27,RC[-3]>=R12C30),""ناجـــح"",""راسب"")"
        y = y + 2
    End If
Next i

 With Sheets("رصد الدور الثاني").Range("a13:a1000")
 .FormulaR1C1 = "=IF(RC[2]=0,"""",SUBTOTAL(3,R13C3:RC[2]))"
 .Value = .Value
   End With
   Sheets("رصد الدور الثاني").Activate
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

 

كنترول الشعراوي للصف الأول.rar

[أبو محمد عاطف]

في ١٥‏/٢‏/٢٠١٧ at 21:11, الشهابي said:

كده تمام استاذنا الحبيب لكن ما بيطلع النتيجة ناجح أو راسب غير لما يتم رصد كل المواد طيب نفترض أن الطالب له دور ثان في مادة واحدة ما الحل ؟ أنا عايز لما أرصد مادة الدور الثاني سواء مادة واحدة أو اثنين أو ثلاث مواد مثلا يكتب ناجح أو راسب لو أقل من درجة النجاح . أرجوا أن تكون وضحت المعلومة . جزاك الله خيرا ... ويا ريت الترحيل يكون المجموع فقط 

[الشهابي]

أخي العزيز / أبو محمد عاطف

تم تعديل المعادلة لتحديد الناجح والراسب من خلال احتساب درجة النجاح في المواد التي ليس له دور ثاني فيها إضافة إلى درجة النجاح لمواد الدور الثاني التي سيتم رصدها 

أي أنها تأخذ شروطها من الصفين معاً للطالب 

بس هناك نقطة لاحظتها وهي ظهور علامات تساوي درجة النجاح لكنها في الأصل هي مقربة مثلا ( 50) وهي في الأصل ( 49.5 ) هل التقريب يحتسب للطالب أم أنه يعتبر راسب 

على الفكرة المعادلة لا تحسب التقريب إنما تحسب الرجة الفعلية لتحديد نتيجة الطالب

هذا الكود بعد تعديل المعادلة

Sub ترحيل()

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
  Dim LR, y As Integer

Sheets("رصد الدور الثاني").Range("A13:AG1000").ClearContents
LR = Range("c10000").End(xlUp).Row


y = 14
For i = 13 To LR
   
    If Cells(i, 33).Value = "دور ثان في" And Cells(i, 3) <> 0 Then
        Range("a" & i).Resize(1, 33).Copy
        Sheets("رصد الدور الثاني").Range("a" & y).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        Sheets("رصد الدور الثاني").Range("ag" & y - 1).FormulaR1C1 = _
        "=IF(AND(OR(RC[-24]>=R12C9,R[1]C[-24]>=R12C9),OR(RC[-21]>=R12C12,R[1]C[-21]>=R12C12),OR(RC[-18]>=R12C15,R[1]C[-18]>=R12C15),OR(RC[-15]>=R12C18,R[1]C[-15]>=R12C18),OR(RC[-12]>=R12C21,R[1]C[-12]>=R12C21),OR(RC[-9]>=R12C24,R[1]C[-9]>=R12C24),OR(RC[-6]>=R12C27,R[1]C[-6]>=R12C27),OR(RC[-3]>=R12C30,R[1]C[-3]>=R12C30)),""ناجـــح"",""راسب"")"
        y = y + 2
    End If
Next i

 With Sheets("رصد الدور الثاني").Range("a13:a1000")
 .FormulaR1C1 = "=IF(RC[2]=0,"""",SUBTOTAL(3,R13C3:RC[2]))"
 .Value = .Value
   End With
   Sheets("رصد الدور الثاني").Activate
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

 

 

 

كنترول الشعراوي للصف الأول.rar

تم تعديل فبراير 18, 2017 بواسطه الشهابي