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

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

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

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

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

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

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

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

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

[ناصر سعيد]

اخي الكريم

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

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

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

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

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

 

[ناصر سعيد]

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

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

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

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

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

 

 

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

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

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

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

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

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

 

[ناصر سعيد]

اخي الكريم

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

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

اخي الكريم

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

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

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

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

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

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

 

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

[ناصر سعيد]

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

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

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

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

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

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

[ناصر سعيد]

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

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

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

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

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

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

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

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

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

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

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

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

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

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

 

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

السلام عليكم

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

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

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

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

 

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

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

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

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

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

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

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

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

 

[ناصر سعيد]

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

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

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