عمل قائمة طلاب بشروط

[علي المصري]

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

لدي قائمة للطلاب وبها درجات الطالب في مادة ما لثلاث فصول دراسية والدرجة من 100

مطلوب استخراج أسماء الطلاب الذين حصلوا على درجات من 0 الى 50

فكيف يمكن عمل ذلك

ويا حبذا اذا تم تشغيل الكود تلقائيا او عن طريق زر امر

 

شكرا

Book1.rar

[سليم حاصبيا]

تفضل الملف جاهز مع قليل من التنسيق الشرطي للايضاح

lest 50 salim.rar

[علي المصري]

جزاك الله خير أستاذ سليم

بارك الله فيك

جميل جيدا ولكني لم افهم مكونات الدة المستخدمة

هل يمكنك توضيح اجزائها

وهل يمكن ترتيب الطلاب الحاصل على العلامات من 0 إلى 50 مثلا من الدرجة الأصغر إلى الأكبر

هل يمكن تحويل الدلة إلى كود vba

متأسف لكثرة الأسئلة ولكن بدون الأسئلة كيف نتعلم

 

شكرا جزيلا

[سليم حاصبيا]

حرب الملف التالي (الورقة الثالثة)

بعد عودتي من العمل أقوم بما فمت بطلبه

 

lest 50 salim.rar

تم تعديل يناير 22, 2016 بواسطه سليم حاصبيا

[ياسر خليل أبو البراء]

أخي الكريم علي المصري

إثراءً للموضوع وإضافة للحل الرائع المقدم من أخونا المتميز سليم إليك حل بالأكواد مع الشرح بالتفصيل ..لتستطيع التعديل بما يتناسب مع ملفك الأصلي

Sub FilterMarks()
    'تعريف المتغيرات
    Dim Counter As Integer, LR As Integer, I As Integer
    
    'إلغاء تحديث الشاشة لتسريع الكود
    Application.ScreenUpdating = False
        
        'بدء التعامل مع ورقة العمل النشطة
        With ActiveSheet
        
            'مسح النطاق الذي ستوضع فيه النتائج
            .Range("J10:M1000").ClearContents
            
            'حلقة تكرارية من 1 إلى 3 حسب عدد الأعمدة التي سيتم التعامل معها
            'فالأعمدة التي سيتم التعامل معها وفلترتها هي العمود ف1 و ف2 و ف3
            For Counter = 1 To 3
            
                'إلغاء الفلترة في ورقة العمل قبل البدء في عمليات الفلترة
                .AutoFilterMode = False
                
                'فلترة النطاق حسب الحقل رقم 2 في الحلقة الأولى ورقم 3 في الحلقة الثانية ورقم 4 في الحلقة الثالثة
                'لنستطيع التعامل مع الثلاثة حقول ف1 و ف2 وف3 [Counter] وهنا استخدمنا المتغير المسمى
                'وشرط الفلترة أكبر من الدرجة صفر وأقل من أو يساوي الدرجة 50
                .Range("B2:E2").AutoFilter Field:=Counter + 1, Criteria1:=">0", Operator:=xlAnd, Criteria2:="<=50"
                
                'نسخ النطاق الذي يحتوي الأسماء ويكون النسخ للخلايا الظاهرة فقط والتي تطابق الشروط
                .Range("B3:B" & Cells(Rows.Count, "B").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy
                
                'لصق الأسماء في العمود المناسب حيث يكون اللصق في أول حلقة في العمود رقم 11
                'وفي الحلقة الثانية في العمود رقم 12 وفي الحلقة الثالثة في العمود رقم 13
                'اللصق يكون للقيم فقط بحيث نحافظ على التنسيقات الموجودة في نطاق النتائج
                .Cells(10, Counter + 10).PasteSpecial xlPasteValues
                
                'تحديد أول خلية في ورقة العمل
                .Range("A1").Select
            
            'الانتقال للحلقة التالية
            Next Counter
            
            'إلغاء الفلترة في ورقة العمل
            .AutoFilterMode = False
            
            'تحديد آخر صف في نطاق النتائج من خلال معرفة عدد صفوف النطاق الحالي مضافاً إليها 7
            'يمثل الرقم 7 عدد الصفوف السابقة للنطاق الحالي أي نطاق النتائج
            LR = .Range("K9").CurrentRegion.Rows.Count + 7
            
            'حلقة تكرارية من الصف رقم 10 إلى آخر صف في النطاق الحالي
            For I = 10 To LR
            
                'الخلية في العمود العاشر تساوي قيمة العداد مطروح منه 9 ليعطي تسلسل للنتائج
                .Cells(I, "J") = I - 9
                
            'الانتقال للحلقة التالية
            Next I
            
        'انتهاء التعامل مع ورقة العمل الحالية
        End With
       
    'إلغاء خاصية القص واللصق بعد عمليات النسخ
    Application.CutCopyMode = False
    
    'إعادة تفعيل تحديث الشاشة
    Application.ScreenUpdating = True
End Sub

تقبل تحياتي

 

Filter & AutoFilter Tutorial YasserKhalil.rar

[علي المصري]

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

يعجز اللسان عن الشكر لكم لما قدمتموه من حلول

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

[ياسر خليل أبو البراء]

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

اخي الكريم علي

الحمد لله أن تم المطلوب على خير وأدى الغرض

تقبل تحياتي