ابن بنها قام بنشر أبريل 4, 2016 قام بنشر أبريل 4, 2016 اريدعدد الطلبه مشكورين يكون من خليه اس 1 ... في صفحة بيلنات المدرسه وجدت الحل sCont = Sheets("بيانات المدرسة").Range("B10") 5 ساعات مضت, ابن بنها said: Option Explicit ' اسماء المواد Const nTEST As String = "عريى" & "," & _ "رياضيات" & "," & _ "دراسات" & "," & _ "انجليزى" & "," & _ "علوم" & "," & _ "مجموع" & "," & _ "رسم" & "," & _ "العاب" & "," & _ "نشاط1" & "," & _ "نشلط 2" & "," & _ "دين" '-------------------------------------- ' ارقام اعمدة الدرجة الاصلية ' بالتسلسل حسب اسماء الموادوعددها Const ColmnTotal As String = "13,22,31,40,51,57,62,67,72,73,82" ' ارقام اعمدة الفصل الثاني 'ويجب ان يتساوى عددها 'مع عدد اسماء المواد 'لعليا التي كتبت ' وهنا المجموع ً Const ColmnTest2 As String = "9,18,27,36,47,54,59,64,69,73,77" ' رقم صف النهاية الصغرى Const iRs As Integer = 6 ' اول صف للبيانات Const TopRow As Integer = 7 Sub kh_Tgrba() Dim sCont As Integer, R As Integer Dim Tst As String On Error GoTo 0 '------------------ ' عدد الطلبة ' ممكن يؤخذ من خلية او يكتب كتابة sCont = Sheets("بيانات المدرسة").Range("B10") '--------------------------------------- Application.ScreenUpdating = False Application.Calculation = xlCalculationManual '------------------ sCont = sCont + TopRow With ActiveSheet For R = TopRow To sCont If Not IsEmpty(.Cells(R, "C")) Then Tst = kh_Test(R) '--متغير اســم ورقم العمود If Len(Tst) Then .Cells(R, "CW") = "له دور ثانى فى" Else .Cells(R, 101) = "ناجح" '--متغيررقم العمود .Cells(R, "CX") = kh_Test(R) End If Next End With 1: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic If Err Then MsgBox "Err.Number : " & Err.Number Err.Clear Else: MsgBox "تم اظهار النتيجة بنجاح" End If End Sub Function kh_Test(iRow As Integer) As String Dim vT, sT Dim NN As String, TT As String Dim ctlt As Integer, ctst As Integer Dim c As Integer, cc As Integer Dim ib As Boolean cc = UBound(Split(nTEST, ",")) For c = 0 To cc ib = False NN = Split(nTEST, ",")(c) ctlt = Split(ColmnTotal, ",")(c) ctst = Split(ColmnTest2, ",")(c) vT = Cells(iRow, ctlt) If Not IsEmpty(vT) Then Select Case vT Case Is = "غ", "غـ": ib = True Case Is < Cells(iRs, ctlt): ib = True End Select End If If ctst = 0 Then GoTo 1 sT = Cells(iRow, ctst) If Not IsEmpty(sT) Then Select Case sT Case Is = "غ", "غـ" NN = NN & " لثلث الدرجة": ib = True Case Is < Cells(iRs, ctst) NN = NN & " لثلث الدرجة": ib = True End Select End If 1: If ib Then TT = TT & IIf(Len(TT), " - ", "") & NN Next kh_Test = TT End Function ' عدد الطلبة ' ممكن يؤخذ من خلية او يكتب كتابة sCont = 700 اريدعدد الطلبه مشكورين يكون من خليه اس 1 ... في صفحة بيلنات المدرسه وجدت الحل sCont = Sheets("بيانات المدرسة").Range("B10")
ياسر خليل أبو البراء قام بنشر أبريل 4, 2016 قام بنشر أبريل 4, 2016 أخي الكريم جرب التالي استبدل الرقم 700 بالشكل التالي sCont = Sheets("بيانات المدرسة").Range("S1").Value 1
gamal asker قام بنشر مايو 25, 2016 قام بنشر مايو 25, 2016 (معدل) فى المرحلة الثانوية فى مادة الاحياء مثلا يكون الرسوب فى 1- العملى 2- ربع الدرجة 3- الدرجة الكلية الكود الحالى فى اثنين فقط ممكن شرط ثالث تم تعديل مايو 25, 2016 بواسطه gamal asker
ناصر سعيد قام بنشر ديسمبر 8, 2016 الكاتب قام بنشر ديسمبر 8, 2016 رابط كنترول ايسم http://up.top4top.net/downloadf-342xxrpa1-rar.html
ناصر سعيد قام بنشر نوفمبر 15, 2017 الكاتب قام بنشر نوفمبر 15, 2017 Dim R As Long Dim X As Long Dim XX As Byte Dim ALL_LESS As String '___________________________________________ Const TOTAL As Byte = 52 'عمود المجموع Const Absent As Byte = 10 'عدد المواد لحساب الغياب Const Since As Byte = 109 'عمود مجموع العلوم Const STATUS As Byte = 101 'عمود الحالة ناجح او دور ثان Const NOTES As Byte = 102 ' عمود الملاحظات عمود المواد او منقول للصف ا لاخر Const GENDER As Byte = 112 ' عمود الجنس ذكر او انثى '_____________________________________________________ Const LESS_ROW As Byte = 6 'صف الدرجة الصغرى Const NAM_ROW As Byte = 2 'صف اسماء المواد Const NAME_FIRST As Byte = 6 ' (اول صف لاسماء الطلاب -1) Const NAME_LAST As Long = 206 + NAME_FIRST ' عدد الطلاب '_____________________________________________________ ARR = Array(9, 18, 27, 36, 109, 54, 59, 64, 69, 78) ' اعمدة اختبار الفصل الدارسي الثاني لجميع المواد ARRY = Array(13, 22, 31, 40, 51, 57, 62, 67, 72, 82) 'اعمدة الدرجة النهائية لجميع المواد ARRYS = Array(5, 14, 23, 32, 41, 53, 58, 63, 68, 74) 'اعمدة اسماء كل المواد '_____________________________________________________ With Sheet2 'متغيراسم شيت البيانات '======================================= '*************************************** Application.ScreenUpdating = False 'الغاء تحديث الشاشة Application.Calculation = xlManual ' ايقاف الحساب التلقائي For R = NAME_FIRST To NAME_LAST ' حلقة تكرارية تبدأ بأول اسم طالب الى اخر اسم For X = 0 To UBound(ARR) ' حلقة تكرارية تبدأ من الصفر الى اقصى مصفوفة اعمدة اختبار الفصل الدارسي الثاني On Error Resume Next '____________________________________________________ 'يتم حساب عدد ا لمواد المتغيب بها الطالب او درجتها صفر ويتم وضع عدد المواد في المتغير اكس اكس 'اذا وصل عدد المواد الى 11 اصبح الطالب متغيب If .Cells(R, ARRY(X)) = 0 Or .Cells(R, ARRY(X)) = "غ" Then XX = XX + 1 End If '____________________________________________________ 'هذا الجزء خاص بمادة العلوم تحديدا الفصل الدراسي الثاني لانه مقسم على عمودين فتم اضافة هذا الجزء ليتم معالجة هذه المرحلة If ARR(X) = Since Then 'لايوجد اختلاف بين هذا الكود وبين الكود الموجود بالاسفل If Val(.Cells(R, ARR(X))) + Val(.Cells(R, ARR(X) + 1)) < Val(.Cells(LESS_ROW, ARR(X))) Or .Cells(R, ARR(X)) = "غ" Or .Cells(R, ARR(X) + 1) = "غ" Then ALL_LESS = ALL_LESS & .Cells(NAM_ROW, ARRYS(X)) & " لثلث الدرجة " & " - ": GoTo 86 GoTo 86 'هنا يتم تخطى عمل الكود بالاسفل حتى لايتم معالجة مادة العلوم مرة اخرى Else GoTo 86 'وهنا ايضا يتم تخطى مادة العلوم الى المادة الاخرى End If End If 'هنا يتم مقارنة المواد بالدرجة الصغرى الخاصة الفصل الدارسي الثاني في اول الكود او اذا كانت غياب يتم اضافة اسم المادة من صف المواد الى المتغير 'ALL_LESS 'او مقارنة الدرجة النهائية لكل مادة بالدرجة الصغرى لها او اذا كانت غياب اذا تحقق الشرط فيتم اضافة المادة الى المتغير 'ALL_LESS '______________________________________________________ If .Cells(R, ARR(X)) < .Cells(LESS_ROW, ARR(X)) Or .Cells(R, ARR(X)) = "غ" Then ALL_LESS = ALL_LESS & .Cells(NAM_ROW, ARRYS(X)) & " لثلث الدرجة " & " - ": 'GoTo 86 End If '_______________________________________________________ 86 Next X 'الذهاب الى المادة الاخرى لاعادة تطبيق الكود مرة اخرى حتى انتهاء جميع المواد If .Cells(R, TOTAL) < .Cells(LESS_ROW, TOTAL) Or .Cells(R, TOTAL) = "غ" Then ALL_LESS = ALL_LESS & .Cells(NAM_ROW, TOTAL) & " لنصف الدرجة " & " - " End If 'اذا كان المتغير اكس اكس بيساوي عدد المواد اذن الطالب متغيب If XX = Absent Then ALL_LESS = "غياب ": XX = 0 '_________________________ 'هنا بعد اكتمال الكود يتم عمل شرط للمتغير 'ALL_LESS 'اذا كان المتغير فارغ اي لم يتم اضافة اي مواد به اذا الطالب ناجح If ALL_LESS = "" Then If .Cells(R, GENDER) = "ذكر" Then .Cells(R, STATUS) = "ناجح " 'اذا كان نوع الطالب ذكر يتم وضع ناجح If .Cells(R, GENDER) = "انثى" Then .Cells(R, STATUS) = "ناجحة " 'اذا كانت انثى يتم وضع ناجحه If .Cells(R, GENDER) = "ذكر" Then .Cells(R, NOTES) = "ومنقول " & INFO.Range("B14") 'ويتم وضع في الملاحظات منقول الى ويتم جلب الصف من صفحة الانفو If .Cells(R, GENDER) = "انثى" Then .Cells(R, NOTES) = "ومنقولة " & INFO.Range("B14") 'مثل ماسبق 'اما اذا كان المتغير يحمل اي بيانات لمواد يصبح الطالب له دور ثان ElseIf ALL_LESS <> "" Then If .Cells(R, GENDER) = "ذكر" Then .Cells(R, STATUS) = "له دور ثان في" 'مثل ما سبق بخصوص النوع If .Cells(R, GENDER) = "انثى" Then .Cells(R, STATUS) = "لها دور ثان في" ' .Cells(R, NOTES) = Left(ALL_LESS, Len(ALL_LESS) - 2) 'هنا يتم وضع قيمة المتغير اي المواد في خلية الملاحظات ALL_LESS = Empty 'تفريغ المتغير لاعادة تعبئة اسم طالب اخر End If '_____________________________________________________ Next R 'الذهاب الى الصف التالي حتى انتهاء عدد الطلاب End With Application.ScreenUpdating = True 'اعادة تحديث الشاشة Application.Calculation = xlAutomatic 'تشغيل الحساب التلقائي End Sub استخراج حالة الطالب ومواد الرسوب نسخه منقحه .rar ================== في بدايه الكود نضع Sub YASSER_ELARABY() 'تم هذا الكود بواسطه المحترم ياسر العربي 'فائده هذا الكود هو استخراج حاله الطالب من 'ناجح او دور تان وكذلك استخراج مواد الدور لتاني 'تم في 28/8/2016
ناصر سعيد قام بنشر ديسمبر 4, 2017 الكاتب قام بنشر ديسمبر 4, 2017 بسم الله الرحمن الرحيم احبابي في الله ادعو الله ان تكونو بخير ياربهذا ملف به كود ممتاز يصلح لرجال التربيه والتعليم وخاصه رجال الكنترول شيت رائع وبه كود الحاله ( ناجح او له دور تان ) ما اسهله وما اروعه ===== Sub استخراج_حالة_الطالب() 'تم هذا الكود بواسطه المحترم ياسر العربي 'فائده هذا الكود هو استخراج حاله الطالب من 'ناجح او دور تان وكذلك استخراج مواد الدور لتاني 'تم في 28/8/2016 'حسب معطيات المحترم ابو احمد محمدي عبد السميع Dim ARR Dim ARRY Dim ARRYS '___________________________________________ Dim R As Long Dim X As Long Dim XX As Byte Dim ALL_LESS As String Dim Main As Worksheet Dim Info As Worksheet Set Main = Sheets("رصد الترم الثانى") Set Info = Sheets("بيانات المدرسة") '___________________________________________ Const STATUS As Byte = 133 'عمود الحالة ناجح او دور ثان Const NOTES As Byte = 134 ' عمود الملاحظات عمود المواد او منقول للصف ا لاخر Const GENDER As Byte = 141 ' عمود الجنس ذكر او أنثى Const TOTAL As Byte = 98 Const LESS_ROW As Byte = 6 'صف الدرجة الصغرى Const NAM_ROW As Byte = 2 'صف اسماء المواد Const NAME_FIRST As Byte = 6 ' (اول صف لاسماء الطلاب -1) Const Absent As Byte = 12 'عدد المواد لحساب الغياب Dim NAME_LAST As Long: NAME_LAST = Info.Range("B10").Value + NAME_FIRST ' عدد الطلاب '====== '_____________________________________________________ 'اعمدة اختبار الترم التاني 'رقم عمود المجموع يكتب هنا ARR = Array(10, 21, 32, 43, 135, 65, 72, 79, 86, 93, 105, 98) 'اعمدة الدرجة النهائية 'ايضارقم عمود المجموع يكتب هنا ARRY = Array(14, 25, 36, 47, 60, 68, 75, 82, 89, 96, 109, 98) 'اعمدة اسماء كل المواد 'ايضارقم عمود المجموع يكتب هنا ARRYS = Array(5, 16, 27, 38, 49, 63, 70, 77, 84, 91, 100, 98) '================= With Main 'اسم شيت البيانات Application.ScreenUpdating = False 'الغاء تحديث الشاشة Application.Calculation = xlManual ' ايقاف الحساب التلقائي For R = NAME_FIRST To NAME_LAST ' حلقة تكرارية تبدأ بأول اسم طالب الى اخر اسم For X = 0 To UBound(ARR) ' حلقة تكرارية تبدأ من الصفر الى اقصى مصفوفة اعمدة اختبار الفصل الدارسي الثاني On Error Resume Next '____________________________________________________ 'يتم حساب عدد ا لمواد المتغيب بها الطالب او درجتها صفر ويتم وضع عدد المواد في المتغير اكس اكس 'اذا وصل عدد المواد الى 11 اصبح الطالب متغيب If .Cells(R, ARRY(X)) = 0 Or .Cells(R, ARRY(X)) = "غ" Then XX = XX + 1 End If '___________________________________________________ If ARR(X) = TOTAL Then 'لايوجد اختلاف بين هذا الكود وبين الكود الموجود بالاسفل If .Cells(R, ARR(X)) < .Cells(LESS_ROW, ARR(X)) Then ALL_LESS = ALL_LESS & .Cells(NAM_ROW, ARRYS(X)) & " لنصف الدرجة " & " - ": GoTo 86 GoTo 86 Else GoTo 86 End If End If '____________________________________________________ 'هنا يتم مقارنة المواد بالدرجة الصغرى الخاصة الفصل الدارسي الثاني في اول الكود او اذا كانت غياب يتم اضافة اسم المادة من صف المواد الى المتغير 'ALL_LESS 'او مقارنة الدرجة النهائية لكل مادة بالدرجة الصغرى لها او اذا كانت غياب اذا تحقق الشرط فيتم اضافة المادة الى المتغير 'ALL_LESS '______________________________________________________ If .Cells(R, ARR(X)) < .Cells(LESS_ROW, ARR(X)) Or .Cells(R, ARR(X)) = "غ" Then ALL_LESS = ALL_LESS & .Cells(NAM_ROW, ARRYS(X)) & " لثلث الدرجة " & " - ": GoTo 86 End If If .Cells(R, ARRY(X)) < .Cells(LESS_ROW, ARRY(X)) Or .Cells(R, ARRY(X)) = "غ" Then ALL_LESS = ALL_LESS & .Cells(NAM_ROW, ARRYS(X)) & " - " End If '______________________________________________________ 86 Next X 'الذهاب الى المادة الاخرى لاعادة تطبيق الكود مرة اخرى حتى انتهاء جميع المواد 'اذا كان المتغير اكس اكس بيساوي عدد المواد اذن الطالب متغيب If XX = Absent Then ALL_LESS = "غياب ": XX = 0 '_____________________________________________________ 'هنا بعد اكتمال الكود يتم عمل شرط للمتغير 'ALL_LESS 'اذا كان المتغير فارغ اي لم يتم اضافة اي مواد به اذا الطالب ناجح If ALL_LESS = "" Then If .Cells(R, GENDER) = "ذكر" Then .Cells(R, STATUS) = "ناجح " 'اذا كان نوع الطالب ذكر يتم وضع ناجح If .Cells(R, GENDER) = "أنثى" Then .Cells(R, STATUS) = "ناجحة " 'اذا كانت أنثى يتم وضع ناجحه If .Cells(R, GENDER) = "ذكر" Then .Cells(R, NOTES) = "ومنقول " & Info.Range("B16") 'ويتم وضع في الملاحظات منقول الى ويتم جلب الصف من صفحة الانفو If .Cells(R, GENDER) = "أنثى" Then .Cells(R, NOTES) = "ومنقولة " & Info.Range("B16") 'مثل ماسبق 'اما اذا كان المتغير يحمل اي بيانات لمواد يصبح الطالب له دور ثان ElseIf ALL_LESS <> "" Then If .Cells(R, GENDER) = "ذكر" Then .Cells(R, STATUS) = "له دور ثان في" 'مثل ما سبق بخصوص النوع If .Cells(R, GENDER) = "أنثى" Then .Cells(R, STATUS) = "لها دور ثان في" ' .Cells(R, NOTES) = Left(ALL_LESS, Len(ALL_LESS) - 2) 'هنا يتم وضع قيمة المتغير اي المواد في خلية الملاحظات ALL_LESS = Empty 'تفريغ المتغير لاعادة تعبئة اسم طالب اخر End If '_____________________________________________________ Next R 'الذهاب الى الصف التالي حتى انتهاء عدد الطلاب End With Application.ScreenUpdating = True 'اعادة تحديث الشاشة Application.Calculation = xlAutomatic 'تشغيل الحساب التلقائي End Sub استخراج حالة الطالب ومواد الرسوب نسخه منقحه1.rar 1
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.