(تمت الاجابة) المساعدة بكود لمعرفة حالة الطالب

[فضل حسين]

الى خبراء واعضاء منتداى العزيز والعظيم

بعد التحية .................... وكل الحب والتقدير والاحترام للجميع

مرفق ملف موضح به المطلوب

وجزاكم جميعا كل خير

حالة الطالب بالكود.rar

[يحيى حسين]

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

جرب هذا الكود

Sub Excel4Us()

Dim LR As Long, c As Range

LR = Range("A" & Rows.Count).End(xlUp).Row

For Each c In Range("a4:A" & LR)

    For i = 1 To 4

        Select Case c.Offset(, i).Value

            Case Is < Cells(3, c.Offset(, i).Column)

                c.Offset(, 5).Value = c.Offset(, 5).Value & " - " & Cells(1, c.Offset(, i).Column)

            Case Is = "غ"

                c.Offset(, 5).Value = c.Offset(, 5).Value & " - " & Cells(1, c.Offset(, i).Column)

        End Select

    Next i

    c.Offset(, 5).Value = Mid(c.Offset(, 5).Value, 4, 255)

Next c

End Sub

[جلال محمد]

استاذ يحيى تسلم يمينك

جزاك الله خير كود رائع

ولكنه لا يعمل تلقائي وايضا لا يقوم بمسح محتويات الخليه عند التغير في درجات الطلاب

[فضل حسين]

استاذى الفاضل / يحيى حسين

كل الحب والتقدير والاحترام لشخصكم الكريم . وسعيد جدا بمشاركتكم جزاكم الله كل خير .

ولكن بعد تجربة الكود اتضح نفس مااوضحة الاخ الفاضل / جلال محمد

اشكر سيادتكم للمرة الثانية ومنتظر ردودكم الكريمة

[يحيى حسين]

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

أخي رايت كليك على اسم الصفحة و اختر

view code

و ثم الصق الكود التالي

Private Sub Worksheet_Change(ByVal Target As Range)

Dim LR As Long, c As Range

LR = Range("A" & Rows.Count).End(xlUp).Row

If Not Intersect(Target, Range("b4:e" & LR)) Is Nothing Then

Range("F4:F" & LR).ClearContents

For Each c In Range("a4:A" & LR)

    For i = 1 To 4

        Select Case c.Offset(, i).Value

            Case Is < Cells(3, c.Offset(, i).Column)

                c.Offset(, 5).Value = c.Offset(, 5).Value & " - " & Cells(1, c.Offset(, i).Column)

            Case Is = "غ"

                c.Offset(, 5).Value = c.Offset(, 5).Value & " - " & Cells(1, c.Offset(, i).Column)

        End Select

    Next i

    c.Offset(, 5).Value = Mid(c.Offset(, 5).Value, 4, 255)

Next c

End If

End Sub

[جلال محمد]

اخي الكريم يحي حسن

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

كده تمام .. الله ينور عليك

[فضل حسين]

استاذى الفاضل / يحيى حسين

بالفعل يااستاذنا الفاضل هو ده المطلوب جزاك الله كل خير وبارك الله فيك . كود رائع وعمل رائع مثل صاحبه .

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

(c.Offset(, 5).Value = Mid(c.Offset(, 5).Value, 4, 255

اشكر سيادتكم للمرة الثانية وربنا يخليك لنا واجمل المنى وارق التهانى لشخصكم الكريم

وفى انتظار ردكم

[يحيى حسين]

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

اخي فضل

عند انتهاء عمل الكود

تكون النتيجة

- عربى - رياضة - كمبيوتر - علوم

لاحظ وجود - زيادة

و وظيفة السطر الذ ذكرته هي الغاء هذه الزيادة

دمت في حفظ الله

[فضل حسين]

الف الف شكر يااستاذنا ياعظيم يحيى حسين

[ناصر سعيد]

بعد اذنكم اريد وضع الكود في ملف