الناجحون والراسبون والمكملون

[عامر ياسر]

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

 

الناجحون والراسبون والمكملون.rar

تم تعديل يوليو 7, 2016 بواسطه alyasryaamir
تم تغيير في الملف

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

11 ساعات مضت, alyasryaamir said:

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

 

الناجحون والراسبون والمكملون.rar

اخى الكريمalyasryaamir

كل عام وانتم بخير جرب المرفق التالى لعلة يفى بالغرض

abo_abary_الناجحون والراسبون والمكملون.rar

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

Sub Result1()
LR = Cells(Rows.Count, 4).End(xlUp).Row
For R = 6 To LR
For c = 5 To 10
For F = 22 To 27
x = ""
If Cells(R, c) < 5 Then
x = x & Cells(4, c)
Cells(R, F) = x
Else
Cells(R, F) = ""
End If
c = c + 1
Next
Next
Next
Call Result2
End Sub
Sub Result2()
LR = Cells(Rows.Count, 4).End(xlUp).Row
For R = 6 To LR
CA = WorksheetFunction.CountA(Range("V" & R & ":Y" & R))
If CA = 0 Then
Cells(R, "M") = "ناجح"
ElseIf CA > 3 Then
Cells(R, "M") = "راسب"
ElseIf CA = 1 Then
Cells(R, "M") = "مكمل بدرس"
ElseIf CA = 2 Then
Cells(R, "M") = "مكمل بدرسين"
ElseIf CA = 3 Then
Cells(R, "M") = "مكمل بثلاث دروس"
End If
Next
End Sub

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

اكتب هذين الكودين وخصص لهما زر

 

 

[عامر ياسر]

26 دقائق مضت, ابو عبدالبارى said:

اخى الكريمalyasryaamir

كل عام وانتم بخير جرب المرفق التالى لعلة يفى بالغرض

abo_abary_الناجحون والراسبون والمكملون.rar

كل عام وانتم بالف خير ..... كل التقدير والاحترام لشخصكم الكريم ابدعت بحق الله يتقبل اعمالكم تعجز لكلمات لمدح والثناء لهذا الموقع والعاملين علية شكرا استاذ ابو عبدالبارى 

22 دقائق مضت, زيزو العجوز said:

Sub Result1()
LR = Cells(Rows.Count, 4).End(xlUp).Row
For R = 6 To LR
For c = 5 To 10
For F = 22 To 27
x = ""
If Cells(R, c) < 5 Then
x = x & Cells(4, c)
Cells(R, F) = x
Else
Cells(R, F) = ""
End If
c = c + 1
Next
Next
Next
Call Result2
End Sub
Sub Result2()
LR = Cells(Rows.Count, 4).End(xlUp).Row
For R = 6 To LR
CA = WorksheetFunction.CountA(Range("V" & R & ":Y" & R))
If CA = 0 Then
Cells(R, "M") = "ناجح"
ElseIf CA > 3 Then
Cells(R, "M") = "راسب"
ElseIf CA = 1 Then
Cells(R, "M") = "مكمل بدرس"
ElseIf CA = 2 Then
Cells(R, "M") = "مكمل بدرسين"
ElseIf CA = 3 Then
Cells(R, "M") = "مكمل بثلاث دروس"
End If
Next
End Sub

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

اكتب هذين الكودين وخصص لهما زر

 

 

كل عام وانت بالف خير ...شكرا لك لسرعة الاجابة ابدعت اخي الكريم 

تم تعديل يوليو 7, 2016 بواسطه alyasryaamir