عامر ياسر قام بنشر يوليو 7, 2016 مشاركة قام بنشر يوليو 7, 2016 (معدل) السلام عليكم . يرجى مساعدتي في هذا الملف الشرح موجود داخله مع فائق شكري وتقديري لكم ولهذا الموقع الاكثر من رائع الناجحون والراسبون والمكملون.rar تم تعديل يوليو 7, 2016 بواسطه alyasryaamir تم تغيير في الملف رابط هذا التعليق شارك More sharing options...
ابو عبدالبارى قام بنشر يوليو 7, 2016 مشاركة قام بنشر يوليو 7, 2016 11 ساعات مضت, alyasryaamir said: السلام عليكم . يرجى مساعدتي في هذا الملف الشرح موجود داخله مع فائق شكري وتقديري لكم ولهذا الموقع الاكثر من رائع الناجحون والراسبون والمكملون.rar اخى الكريمalyasryaamir كل عام وانتم بخير جرب المرفق التالى لعلة يفى بالغرض abo_abary_الناجحون والراسبون والمكملون.rar 1 رابط هذا التعليق شارك More sharing options...
ابراهيم الحداد قام بنشر يوليو 7, 2016 مشاركة قام بنشر يوليو 7, 2016 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 السلام عليكم ورحمة الله اكتب هذين الكودين وخصص لهما زر 1 رابط هذا التعليق شارك More sharing options...
عامر ياسر قام بنشر يوليو 7, 2016 الكاتب مشاركة قام بنشر يوليو 7, 2016 (معدل) 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 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان