اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

كود لعمود الحاله وعمود مواد الدور الثاني

ناصر سعيد

بواسطه ناصر سعيد
في منتدى الاكسيل Excel

 مشاركة

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

ابن بنها

ابن بنها

قام بنشر
قام بنشر

 

 اريدعدد الطلبه مشكورين يكون من خليه اس     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")

 

رابط هذا التعليق
شارك
  • 1 month later...
gamal asker

gamal asker

قام بنشر
قام بنشر (معدل)

فى المرحلة الثانوية  فى مادة الاحياء مثلا يكون الرسوب فى

1- العملى

2- ربع الدرجة

3- الدرجة الكلية

الكود الحالى فى اثنين فقط ممكن شرط ثالث

تم تعديل بواسطه gamal asker
رابط هذا التعليق
شارك
  • 2 weeks later...
  • 6 months later...
  • 11 months later...
ناصر سعيد

ناصر سعيد

قام بنشر
  • الكاتب
قام بنشر

  

    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

 

رابط هذا التعليق
شارك
  • 3 weeks later...
ناصر سعيد

ناصر سعيد

قام بنشر
  • الكاتب
قام بنشر

بسم الله الرحمن الرحيم
احبابي في الله
ادعو الله ان تكونو بخير يارب
هذا ملف به كود ممتاز يصلح لرجال التربيه والتعليم وخاصه رجال الكنترول
شيت رائع وبه كود الحاله ( ناجح او له دور تان )
ما اسهله وما اروعه
===== 

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

  • Like 1
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 مشاركة
الذهاب الي قائمه المواضيع

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

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information

  I accept