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

تكوين فصول للمحترم محمود الشريف

Recommended Posts

تكوين قوائم فصول المدرسة

هذا الملف من ابداع المحترم محمود الشريف  .. وهو خاص بتكوين قوائم للفصول المدرسيه .. ولاأروع منه

جزاه الله عنا كل خير وبارك له

طريقه العمل مع الملف

اضغط زر القيم الفريده ليجلب اسماء الفصول مرتبه

اختر بعد ذلك الفصل الذي تريد استخراج قائمته

من الخليه L1

========================

تكوين فصول للمحترم محمود الشريف.rar

====

خطوط رائعه يمكن ان تضاف الى الجهاز لتجميل قائمه الفصل

=================

خط.rar

==========

رابط لخطوط غايه في الجمال والروعه

https://up.top4top.net/downloadf-3206k2ma1-rar.html

تم تعديل بواسطه ناصر سعيد
تنسيق الصفحه
  • Like 1

شارك هذه المشاركه


رابط المشاركه
شارك

شكرا لك وللأستاذ محمود الشريف

ولكن الملف لا يشتغل عندي، تظهرالرسالة التي بالصورة 

يتم اصلاحه بالضغط على "yes" وكن تختفي جميع الاكود 

لا ادري ان كانت المشكلة عندي فقط :wallbash:

1.JPG

شارك هذه المشاركه


رابط المشاركه
شارك

الاستاذ محمود الشريف جزاه الله خيرا

شرح الكود الخاص به لتوزيع الفصول وهذا هو المرفق

 

 

إنشاء قوائم الفصول1.rar

====================

Sub MZM_START()
' الاعلان عن المتغيرات وعددهم خمسة
Dim MyRange As Range
Dim R As Integer, C As Integer, M As Integer, Y As Integer, t As Integer
'تعريف مدى البيانات بشيت بيانات الطلبة الذى يتم جلب البيانات منه
'='بيانات الطلبة'!$A$10:$AK$1009
'بإسم school
Set MyRange = Range("School")
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False

'=================================
' مسح البيانات
'استدعاء كود مسح البيانات بشيت قوائم الفصول
'لإستقبال البيانات الجديدة وهذا المدى تم تحديده داخل  الكود
'("B11:L60")

MZM_ClearContents
'=================================
' فرز School
'استدعاء كود الفرز للبيانات بشيت بيانات الطلبة

MZM_Sort
'=================================
'تم وضع شرط إضافة نصف عدد الفصل بالخلية
'E2
'وفى حال عدم وجود بيانات بتلك الخلية يتم التنفيذ بناء على شرط افتراضى
'أن نصف عدد الفصل يساوى 50 طالب
'نلاحظ أنه فى حالة عدم ادخال رقم بهذه الخلية سيتم جلب البيانات داخل قائمة واحدة
'ولن يتم قسمة عدد إجمالى طلاب الفصل على قائمتين

If IsEmpty(Range("E2")) Or IsNumeric(Range("E2")) = False Then t = 50 Else t = Range("E2").Value
'تحديد صف رؤوس الجدول بالصف العاشر
C = 10
With MyRange
'بداية حلقة تكرارية لجلب البيانات المطلوبة مع وضع شروط لها كالتالي

    For R = 1 To .Rows.Count
        If .Cells(R, 2) <> "" Then
           ' اضافة شرط ان العمود الرابع بشيت بيانات الطلبة يتوافق مع رقم الفصل المطلوب بالخلية
           'L2
           'الموجود بها قائمة الفصول بشيت قوائم الفصول

            If .Cells(R, 4).Text = Range("L2").Text Then
                'وضع شرط فى حال توافر بيانات بالخلية
                'J2
                'القائمة المنسدلة الخاصة بالنوع ذكر أم أنثى يعمل الكود على أساسها
                'فى حال عدم توافر بيانات بها يستمر الكود فى عمله
                'شرط أن تتوافق الخلية مع العمود رقم 18 بالشيت الرئيسى
                If Range("J2").Text = "" Then GoTo 1
                If .Cells(R, 18).Text = Range("J2").Text Then
1               If M >= t Then Y = 6: M = 0
                    M = M + 1
                   'تم اضافة شرط خاص بتنسيق الجدول حسب تواجد رؤوس الأعمدة بشيت قوائم الفصول
                   'نقول فيه أن
                   'Y = 6
                   'أى أن عدد أعمدة كل قائمة من القائمتين بشيت قوائم الفصول والتى يتم جلب بيانات فيها عددها 6 أعمدة
                    If Y = 6 Then Cells(C + M, Y + 2) = M + t Else Cells(C + M, Y + 2) = M
                   'العمود الثالث بشيت قوائم الفصول يتم جلب البيانات إليه من العمود الثاني بشيت بيانات الطلبة
                   'مع ملاحظة أنه حسب الشروط فى حالة توافق شرط نصف عدد الطلاب حسب الخلية
                   'E2
                   'يتم قسمة عدد الطلاب على القائمتين بحيث أن العمود الثالث بشيت قوائم الفصول سيتم
                   'استكمال البيانات بالعمود التاسع بشيت قوائم الفصول
                   'وهذا ما تعنية
                   'Y + 3
                   'وهكذا فى باقي الأعمدة
                    Cells(C + M, Y + 3) = .Cells(R, 2)
                   'العمود الرابع بشيت قوائم الفصول يتم جلب البيانات إليه من العمود ال 17 بشيت بيانات الطلبة
                    Cells(C + M, Y + 4) = .Cells(R, 17)
                   'العمود الخامس بشيت قوائم الفصول يتم جلب البيانات إليه من العمود ال 11 بشيت بيانات الطلبة
                    Cells(C + M, Y + 5) = .Cells(R, 11)
                   'العمود السادس بشيت قوائم الفصول يتم جلب البيانات إليه من العمود ال 7 بشيت بيانات الطلبة
                    Cells(C + M, Y + 6) = .Cells(R, 7)
                End If
            End If
        End If
    Next R
End With
'=================================
'اخفاء الصفوف المتبقية من التعيين
If t = 50 Then GoTo 2
With Range("B11:L60")
'يتم اخفاء الصفوف الفارغة والتى زادت عن نصف عدد الفصل من الطلاب والذى تم تحديده بـ 50
    .Offset(t, 0).Resize(50 - t).EntireRow.Hidden = True
End With
'=================================
    Application.Calculation = xlCalculationAutomatic

2 Application.ScreenUpdating = True
End Sub
Sub MZM_ClearContents()
'يتم مسح هذا المدى لتجهيز الشيت لإستقبال بيانات جديدة
'مع إظهار الصفوف التى تم إخفاؤها
With Range("B11:L60")
    .ClearContents
   .EntireRow.Hidden = False
End With
End Sub
Sub MZM_Sort()
'عملية فرز للمدى المحدد بإسم
'School
'بشيت بيانات الطلبة بالعمودين
'A , B
With Range("School")
    .Sort .Columns("A:A"), xlAscending
    .Sort .Columns("B:B"), xlDescending
End With
End Sub

 

شارك هذه المشاركه


رابط المشاركه
شارك
Sub SortData()

    Dim lr As Long

    lr = Range("E" & Rows.Count).End(xlUp).Row

    For Each Cell In ActiveSheet.Range("E7:E" & lr)

        Cell.Value = Application.WorksheetFunction.Trim(Cell.Value)

    Next

    Range("B7:S" & lr).Sort Key1:=Range("F7:F" & lr), Order1:=2, Key2:=Range("E7:E" & lr), Order2:=1, Header:=xlNo

End Sub

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

ولكن به اضافه مفيده

وهي ازاله المسافات من بين الاسماء

مما تعطي فرزا دقيقا

للمحترم الغالي ياسر العربي

شارك هذه المشاركه


رابط المشاركه
شارك

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

يجب ان تكون عضوا لدينا لتتمكن من التعليق

انشئ حساب جديد

سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .

سجل حساب جديد

تسجيل دخول

هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.

سجل دخولك الان


  • المتواجدين الان   0 اعضاء متواجدين الان

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

×