ترحيل

أبو محمد عاطف · فبراير 14, 2017

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

**الشهابي** · فبراير 15, 2017

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

ضع هذا الكود في موديول لترحيل الدور الثاني وأربطه بزر ( ترحيل لرصد دور الثاني ) في ورقة ( شيت آخر العام 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

أبو محمد عاطف · فبراير 15, 2017

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

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

**محمود_الشريف** · فبراير 15, 2017

أخى الحبيب

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

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

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

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

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

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

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

ياسر خليل أبو البراء · فبراير 15, 2017

السلام عليكم

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

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

أبو محمد عاطف · فبراير 15, 2017

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

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

السلام عليكم

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

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

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

ياسر خليل أبو البراء · فبراير 15, 2017

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

أبو محمد عاطف · فبراير 15, 2017

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

**الشهابي** · فبراير 15, 2017

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

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

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

اقتباس

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

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

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 بواسطه الشهابي

أبو محمد عاطف · فبراير 17, 2017

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

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

**الشهابي** · فبراير 17, 2017

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

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

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

أبو محمد عاطف · فبراير 18, 2017

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

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

**الشهابي** · فبراير 18, 2017

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

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

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

بس هناك نقطة لاحظتها وهي ظهور علامات تساوي درجة النجاح لكنها في الأصل هي مقربة مثلا ( 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 بواسطه الشهابي

تسجيل الدخول

ترحيل

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

أبو محمد عاطف

الشهابي

أبو محمد عاطف

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

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

أبو محمد عاطف

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

أبو محمد عاطف

الشهابي

أبو محمد عاطف

الشهابي

أبو محمد عاطف

الشهابي

Join the conversation

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

تصفح الموقع

تصفح جديد الموقع

Support

Important Information