كود نرحيل الناجح والراسب نصف العام وآخر العام على نفس ورقة العمل

الأستاذ / محمد الدسوقى · يناير 6, 2017

الأخوة الكرام أعضاء المنتدى

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

من فضلكم اريد كود لترحيل الراسب والناجح ( نصف العام ـ و آخر العام ) من الورقة الأولى ( المصدر ) . SH

إلى الورقة الثانية ( الهدف ) N_R. اعتمادا على الشرط الموجود فى القائمة المنسدلة الموجودة فى ورقة الهدف فى الخلية B1

مرفق ملف بالمطلوب

سدد الله خطاكم بالتوفيق

ترحيل ناجح وراسب.rar

**ناصر سعيد** · يناير 7, 2017

اخي الكريم

ماهو معيار النجاح في نصف العام ؟

وماهو معيار النجاح في اخر العام ؟

الأستاذ / محمد الدسوقى · يناير 7, 2017

معيار النجاح فى نصف العام هو كلمة ( ناجح ) فى نصف العام فى العمود ( M ) أما معيار الرسوب : فى نصف العام كلمة ( برنامج علاجى )

معيار النجاح فى آخرالعام هو كلمة ( ناجح ) فى العمود ( O) أما معيار الرسوب لآخر العام : ( دور ثان ) فى نفس العمود

**ناصر سعيد** · يناير 7, 2017

معيار النجاح في اخر العام

1- ان يحصل الطالب على ثلث درجة امتحان التحريري

2- ان يكون حاضر وليس غائب

3- ان يحصل على نصف او اكثر من درجة مجموع نفس المادة

فماهو معيار النجاح في نصف العام اخي الكريم ؟

الأستاذ / محمد الدسوقى · يناير 7, 2017

معيار النجاح في نصف العام

1- ان يحصل على 50 % على الأقل من درجة مجموع نفس المادة

2- ان يكون حاضر وليس غائب

استفسار بسيط : مش ممكن نستخرج هذه البيانات على اساس معيار كلمة ناجح وراسب ودور ثان

وأشكرك أخى الكريم على سعة صدرك

**ناصر سعيد** · يناير 7, 2017

اخي الكريم

انا اردت بهذه الاسئله ان تكون مرجعا لاخوه لنا في المنتدى يحتاجونها

مش جزئيه في موضوع تنحل لصاحب الجزئيه ونترك الموضوع كله ليعاد طرحه مره ومره

اخي الكريم

رجاء ضع المرفق الذي ارفقته

كاملا بمعادلاته حتى يستفيد منه آخرون

ولها رب يعدلها

**ابراهيم الحداد** · يناير 7, 2017

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

اتمنى من الله عز وجل ان يكون هذا هو المطلوب

ترحيل ناجح وراسب.rar

**ناصر سعيد** · يناير 7, 2017

Sub TranResult1()
' الكود من ابداع المحترم زيزو العجوز
'الهدف من الكود استخراج الناجحين عن طريق قائمه منسدله
'تم عمل هذا الكود في 7/1/2017
Sheet8.Range("A12:Z500").ClearContents
Dim An As Variant, Ar As Variant, LR As Long, R As Integer
Application.ScreenUpdating = False
Sheet3.Activate
LR = Range("C" & Rows.Count).End(xlUp).Row
An = Array(2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 19, 29, 39, 50, 61, 69, _
73, 78, 83, 88, 93, 99)
For i = LBound(An) To UBound(An)
n = 11
For R = 12 To LR
If Cells(R, "M") = "ناجح" Then
n = n + 1
With Sheet8
.Cells(n, "A") = (n - 11)
.Cells(n, i + 2) = Cells(R, An(i))
End With
End If
Next
Next
Sheet8.Select
Application.ScreenUpdating = True
End Sub

جزاك الله خيرا ونتعشم في شرح اسطره

**ابو عبدالبارى** · يناير 7, 2017

الأخ الكريم الأستاذ / محمد الدسوقى

جرب الملف التالى لعلة يفى بالغرض

abo_abary_ترحيل ناجح وراسب.rar

**ناصر سعيد** · يناير 7, 2017

Sub ABO_ABARY()
Dim R As Integer, M As Integer, N As Integer
Sheets("N_R").Range("A11:Z1010").ClearContents
Sheets("N_R").Range("A11:Z1010").ClearFormats
       M = 10
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Select Case [C1]
    Case "ناجح نصف العام "
         For R = 12 To 1010
              If Sheets("MAIN").Cells(R, 13) = "ناجح" Then
                 M = M + 1
      Union(Sheets("MAIN").Range("B" & R & ":N" & R), Sheets("MAIN").Range("S" & R), Sheets("MAIN").Range("AC" & R), Sheets("MAIN").Range("AM" & R), Sheets("MAIN").Range("AX" & R), Sheets("MAIN").Range("BI" & R), Sheets("MAIN").Range("BQ" & R), Sheets("MAIN").Range("BU" & R), Sheets("MAIN").Range("BZ" & R), Sheets("MAIN").Range("CE" & R), Sheets("MAIN").Range("CJ" & R), Sheets("MAIN").Range("CO" & R), Sheets("MAIN").Range("CU" & R)).Copy
             With Sheets("N_R")
             .Range("B" & M).PasteSpecial xlPasteValues
             .Range("B" & M).PasteSpecial xlPasteFormats
             .Range("A" & M) = M - 10
                    End With
                      Application.CutCopyMode = False
             Application.CutCopyMode = False
             End If
    Next
 Case "راسب نصف العام"
         For R = 12 To 1010
              If Sheets("MAIN").Cells(R, 13) = "برنامج علاجى" Then
                 M = M + 1
      Union(Sheets("MAIN").Range("B" & R & ":N" & R), Sheets("MAIN").Range("S" & R), Sheets("MAIN").Range("AC" & R), Sheets("MAIN").Range("AM" & R), Sheets("MAIN").Range("AX" & R), Sheets("MAIN").Range("BI" & R), Sheets("MAIN").Range("BQ" & R), Sheets("MAIN").Range("BU" & R), Sheets("MAIN").Range("BZ" & R), Sheets("MAIN").Range("CE" & R), Sheets("MAIN").Range("CJ" & R), Sheets("MAIN").Range("CO" & R), Sheets("MAIN").Range("CU" & R)).Copy
             With Sheets("N_R")
             .Range("B" & M).PasteSpecial xlPasteValues
             .Range("B" & M).PasteSpecial xlPasteFormats
             .Range("A" & M) = M - 10
                    End With
                      Application.CutCopyMode = False
             Application.CutCopyMode = False
             End If
    Next
    Case "ناجح آخر العام"
         For R = 12 To 1010
              If Sheets("MAIN").Cells(R, 15) = "ناجح" Then
                 M = M + 1
      Union(Sheets("MAIN").Range("B" & R & ":L" & R), Sheets("MAIN").Range("O" & R & ":P" & R), Sheets("MAIN").Range("Y" & R), Sheets("MAIN").Range("AI" & R), Sheets("MAIN").Range("AS" & R), Sheets("MAIN").Range("BE" & R), Sheets("MAIN").Range("BO" & R), Sheets("MAIN").Range("BS" & R), Sheets("MAIN").Range("BX" & R), Sheets("MAIN").Range("CC" & R), Sheets("MAIN").Range("CH" & R), Sheets("MAIN").Range("CM" & R), Sheets("MAIN").Range("CQ" & R), Sheets("MAIN").Range("DA" & R)).Copy
             With Sheets("N_R")
             .Range("B" & M).PasteSpecial xlPasteValues
             .Range("B" & M).PasteSpecial xlPasteFormats
             .Range("A" & M) = M - 10
                    End With
                      Application.CutCopyMode = False
             Application.CutCopyMode = False
             End If
    Next
    Case "راسب آخر العام"
         For R = 12 To 1010
              If Sheets("MAIN").Cells(R, 15) = "دور ثان" Then
                 M = M + 1
      Union(Sheets("MAIN").Range("B" & R & ":L" & R), Sheets("MAIN").Range("O" & R & ":P" & R), Sheets("MAIN").Range("Y" & R), Sheets("MAIN").Range("AI" & R), Sheets("MAIN").Range("AS" & R), Sheets("MAIN").Range("BE" & R), Sheets("MAIN").Range("BO" & R), Sheets("MAIN").Range("BS" & R), Sheets("MAIN").Range("BX" & R), Sheets("MAIN").Range("CC" & R), Sheets("MAIN").Range("CH" & R), Sheets("MAIN").Range("CM" & R), Sheets("MAIN").Range("CQ" & R), Sheets("MAIN").Range("DA" & R)).Copy
             With Sheets("N_R")
             .Range("B" & M).PasteSpecial xlPasteValues
             .Range("B" & M).PasteSpecial xlPasteFormats
             .Range("A" & M) = M - 10
                    End With
                      Application.CutCopyMode = False
             Application.CutCopyMode = False
             End If
    Next
    End Select
    Application.Calculation = xlCalculationAutomatic

End Sub

جزاكم الله كل خير

الأستاذ / محمد الدسوقى · يناير 7, 2017

الأخ الفاضل الأستاذ / زيزو العجوز

الأخ الفاضل الأستاذ / أبو عبد البارى

----------------------------------------------------

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

--------------------------------------------------------

تعجز الكلمات عن مدى شكرى وامتنانى لكما على هذين الكودين

أنقذتمونى من بحر المعادلات التى قمت بتطبيقها و التى تؤثر سلبا على حجم الملف وسرعته

جزاكم الله خيرا أحبتى فى الله وجعلكم الله عونا لنا دائما على الخير ما حيينا

ملحوظة صغيرة : على كود الأستاذ الفاضل زيزو العجوز لمن يريد العمل على نفس الملف المرفق قم بتغيير الر قم ( n=11)فى الكود إلى ( n=10),

وكذلك ( n-11)فى الكود إلى ( n-10)

وفقكم الله دائما إلى الخير والسداد

ياسر خليل أبو البراء · يناير 8, 2017

السلام عليكم

فيه موضوع بعنوان الشرح المستفيض للمصفوفات

http://yasserkhalilexcellover.blogspot.com.eg/2016/10/search-using-arrays.html

أعتقد أنه سيفيدك في الموضوع إذا كنت تريد أداء أسرع من الحلقات التكرارية .. حاول فقط التركيز في الشرح وإن شاء الله تقدر تستفيد منه

وفقكم الله جميعاً لما فيه الخير والصلاح

الأستاذ / محمد الدسوقى · يناير 14, 2017

أخى الحبيب المبدع الأستاذ الفاضل / ياسر خليل

----------------------------------------------------

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

--------------------------------------------------------

شكر خاص على المجهود الذى تبذلـه من أجل مساعدة الآخرين جعله الله فى ميزان حسناتك وفقكم الله دائما إلى الخير حيثما كان

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

جزاكـــــــــــــــــــــــــــــــم اللـــــــــــه خيـــــــــــــرا

**ناصر سعيد** · يناير 14, 2017

هل استطعت اخي الكريم

من استخدام كود الاستاذ ياسر العربي في ملفك ؟

اذا كان كذلك ففضلا ارفق المرفق وبه كود الاستاذ ياسر العربي

تسجيل الدخول

كود نرحيل الناجح والراسب نصف العام وآخر العام على نفس ورقة العمل

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

الأستاذ / محمد الدسوقى

ناصر سعيد

الأستاذ / محمد الدسوقى

ناصر سعيد

الأستاذ / محمد الدسوقى

ناصر سعيد

ابراهيم الحداد

ناصر سعيد

ابو عبدالبارى

ناصر سعيد

الأستاذ / محمد الدسوقى

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

الأستاذ / محمد الدسوقى

ناصر سعيد

Join the conversation

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

تصفح الموقع

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

Support

Important Information