سؤال في سجل فصل بنين ثم بنات حسب خلية

أبو يوسف النجار · سبتمبر 7, 2016

السلام عليكم لخبراء المنتدى

بالملف المرفق أريد من صفحة ( سجل فصل ) تقسيم الفصول حسب قائمة منسدلة بالخلية M2

قائمة سجل فصل عليا أولاد منفردة وقائمة سفلى منفردة بنات ومرتبة وهذا حسب بيانات الصفحة الرئيسية السجل 2 وهذا بالطبع حسب التغيير بالخلية M2

سجل فصل.rar

تم تعديل سبتمبر 7, 2016 بواسطه أبو يوسف النجار

أبو يوسف النجار · سبتمبر 8, 2016

نرجو الرد على السؤال ان أمكن

**ابراهيم الحداد** · سبتمبر 8, 2016

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

الصق هذا الكود فى موديول وخصص له زر

Sub Tarhil_Boys()
Range("C11:U46").ClearContents
Range("C55:U89").ClearContents
LR = Sheet1.Cells(Rows.Count, 3).End(xlUp).Row
For R = 9 To LR
If Sheet1.Cells(R, 4) = "ذكر" Then
B = Application.WorksheetFunction.CountIf(Sheet1.Range("F9:F" & R), Cells(2, "M"))
If Cells(2, "M") = Sheet1.Cells(R, 6) Then
B = B + 11
Range("C" & B) = Sheet1.Cells(R, 3)
Range("D" & B) = Sheet1.Cells(R, 27)
Range("E" & B) = Sheet1.Cells(R, 9)
Range("F" & B) = Sheet1.Cells(R, 10)
Range("G" & B) = Sheet1.Cells(R, 11)
Range("H" & B) = Sheet1.Cells(R, 12)
Range("I" & B) = Sheet1.Cells(R, 19)
Range("J" & B) = Sheet1.Cells(R, 5)
Range("K" & B) = Sheet1.Cells(R, 2)
Range("Q" & B) = Sheet1.Cells(R, 14)
Range("T" & B) = Sheet1.Cells(R, 18)
End If
End If
Next
Call Tarhil_Girls
End Sub
Sub Tarhil_Girls()

x = Cells(Rows.Count, 3).End(xlUp).Row - 1
LR = Sheet1.Cells(Rows.Count, 3).End(xlUp).Row
For R = 9 To LR
If Sheet1.Cells(R, 4) = "أنثى" Then
B = Application.WorksheetFunction.CountIf(Sheet1.Range("F9:F" & R), Cells(2, "M"))
If Cells(2, "M") = Sheet1.Cells(R, 6) Then
B = B + 64 - x
Range("C" & B) = Sheet1.Cells(R, 3)
Range("D" & B) = Sheet1.Cells(R, 27)
Range("E" & B) = Sheet1.Cells(R, 9)
Range("F" & B) = Sheet1.Cells(R, 10)
Range("G" & B) = Sheet1.Cells(R, 11)
Range("H" & B) = Sheet1.Cells(R, 12)
Range("I" & B) = Sheet1.Cells(R, 19)
Range("J" & B) = Sheet1.Cells(R, 5)
Range("K" & B) = Sheet1.Cells(R, 2)
Range("Q" & B) = Sheet1.Cells(R, 14)
Range("T" & B) = Sheet1.Cells(R, 18)
End If
End If
Next
End Sub

ياسر خليل أبو البراء · سبتمبر 8, 2016

أخي الكريم أبو يوسف النجار

قدم لك الأخ زيزو العجوز كود وحل لمشكلتك ولكن نصيحة حاول ألا تستخدم الخلايا المدمجة قدر الإمكان ..

لي سؤال : هل عدد الصفوف التي ستضع فيها البيانات ثابتة أقصد مثلا عدد 35 صف دائماً .. ماذا لو زاد عدد التلاميذ عن 35 طالب ..؟ وماذا لو كان أقل؟

لو كان أقل سيكون هناك عدد صفوف فارغة بين سجل البنين وسجل البنات .. وهل هذا مقبول شكلاً؟

وماذا عن الخلايا المدمجة هل هي ضرورية ؟ لأن الكود المقدم سيعطي رسائل خطأ إذا استخدمته على الملف المرفق بشكل مباشر .. وذلك بسبب الخلايا المدمجة ..

أمور لابد من توضيحها ..

أبو يوسف النجار · سبتمبر 9, 2016

الأستاذ /

زيزو العجوز

شكرا جزيلا وبارك الله فيك

حبيبي مستر ياسر

أسئلتك ممتازة وفي الصميم نعم العدد غير ثابت في كل صف والخلايا المدمجة غير ضرورية أرجو من سيادتك التعديل

ياسر خليل أبو البراء · سبتمبر 9, 2016

أخي أبو يوسف

حاول أن تساعدنا بوضع التصميم المطلوب وضع شكل النتائج المتوقعة كدليل لنا .. حتى نستطيع تقديم المساعدة

الملف ملفك والتصميم والمخرجات تخصك (فقط حاول ألا تستخدم الخلايا المدمجة قدر الإمكان)

أبو يوسف النجار · سبتمبر 9, 2016

حاضر يا مستر / ياسر

أبو يوسف النجار · سبتمبر 9, 2016

الملف المطلوب و بداخله المطلوب وجزاكم الله خيرا

سجل فصل.rar

قلم-الاكسل(عبدالعزيز) · سبتمبر 9, 2016

كود ممتاز ايها المبدع زيزو لن اقول العجوز لانه انتقاص من حقك باركتك السماء في عمرك

أبو يوسف النجار · سبتمبر 9, 2016

تم التعديل على الملف والمطلوب بداخله أرجو الرد

سجل فصل.rar

ياسر خليل أبو البراء · سبتمبر 9, 2016

أخي الكريم أبو يوسف ..

أراك أرفقت ملف آخر .. هل يختلف عن السابق وهل هناك جديد ؟

حاول تركز في مرفق واحد فقد يكون أحدهم بدأ العمل على الموضوع ... والرجاء شرح التفاصيل في المشاركة نفسها لتتضح الصورة قبل تحميل المرفق

تقبل تحياتي

أبو يوسف النجار · سبتمبر 9, 2016

هو هو نفس الملف والله بس أزلت الخلايا المدمجة

أريد عمل قائمة للفصل على أساس البيانات بصفحة ( السجل 2 ) وتكون القائمة باستدعاء رقم الفصل من القائمة الموجود بخلية M2 بصفحة ( سجل فصل ) وتكون القائمة منقسمة لجزئين جزء خاص بالبنين أعلى الصفحة والزء الثاني للبنات أسفل الصفحة وويكون كل منهما مسلسل من 1 إلى 2 إلى 3 حتى 40 مثلا ولا يكون العدد ثابت لأن هناك فصول تزيد عن 30 مثلا وفصول تقل عن 30 ولكن الأقصى 40

طلب بديل : وإن لم يمكن الحل السابق يمكن بطريقة التصفية مرتين اختر الفصل ثم النوع فتظهر القائمة

سجل فصل.rar

الأستاذ / محمد الدسوقى · سبتمبر 9, 2016

أخى الفاضل / أبو يوسف ... السلام عليكم

هذا حل بسيط إن شاء الله للمطلوب من الملف

أجريت بعض التنسيقات اللازمة على ورقة العمل لتبدو على الشكل المطلوب

قمت بادخال المعادلات المطلوبة لذلك وشغالة إن شاء الله ـ

أدرجت ورقة عمل جديدة باسم ( Mohamed El_Desoky) فيها المطلوب ـ أرجو تجربتها والرد عليها

تقبل تحياتى

سجل فصل.xlsm ـ محمد الدسوقى.rar

أبو يوسف النجار · سبتمبر 9, 2016

:dance1:

أستاذ / محمد الدسوقى بارك الله فيك

الملف هو المطلوب أعزك الله وجزاك الله خير على تعبك

ياسر خليل أبو البراء · سبتمبر 10, 2016

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

أثناء تقديم الحل كنت أقوم بكتابة كود .. يقوم بعمل اللازم أما التنسيقات فعادية يمكنك تنسيق ورقة العمل كما تريد ، كما يمكنك استخدام الخلايا المدمجة في العناوين لا مشكلة في ذلك)

سيقوم الكود بعمل اللازم وترك 5 صفوف فارغة بين سجل البنون وسجل البنات ...

أرجو أن يفي بالغرض إن شاء الله

هذا هو الكود المستخدم

'https://www.officena.net/ib/topic/71660-*
'=========================================

Sub Lists_Using_Arrays()
'Author  : YasserKhalil
'Release : 10 - 09 - 2016
'------------------------
    Dim Ws As Worksheet, Sh As Worksheet, sSheet As Worksheet
    Dim Crit As String
    Dim I As Long, J As Long, P As Long
    Dim Lr As Long, Last As Long
    Dim Arr, Temp

    Application.ScreenUpdating = False
        Set Ws = Sheets("Data"): Set Sh = Sheets("Lists")
        Crit = Sh.Range("M2").Value
        P = 1
    
        Sh.Rows("10:" & Rows.Count).EntireRow.Delete
        Sh.Range("K5:M5").ClearContents
        If Crit = "" Or Application.WorksheetFunction.CountIf(Ws.Range("F:F"), Crit) = 0 Then MsgBox "Fill The Cell M2", vbExclamation: Exit Sub
        Arr = Ws.Range("A9:AA" & Ws.Cells(Rows.Count, 1).End(xlUp).Row).Value
        ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2) - 5)
    
        For I = 1 To UBound(Arr, 1)
            If Arr(I, 6) = Crit Then
                Temp(P, 1) = P: Temp(P, 2) = Arr(I, 3): Temp(P, 3) = Arr(I, 27)
                For J = 4 To 7
                    Temp(P, J) = Arr(I, J + 5)
                Next J
                Temp(P, 8) = Arr(I, 19): Temp(P, 9) = Arr(I, 5): Temp(P, 10) = Arr(I, 2)
                For J = 16 To 18
                    Temp(P, J) = Arr(I, J - 2)
                Next J
                Temp(P, 19) = Arr(I, 18): Temp(P, 20) = P
                Temp(P, 21) = Arr(I, 6): Temp(P, 22) = Arr(I, 4)
                P = P + 1
            End If
        Next I
    
        Sheets.Add After:=Sheets(Sheets.Count)
        Set sSheet = ActiveSheet
    
        With sSheet
            .Columns("U:U").NumberFormat = "@"
            .Range("U1") = "Class": .Range("V1") = "Gender"
            .Range("A2").Resize(P, UBound(Temp, 2)).Value = Temp
            Lr = .Cells(Rows.Count, 1).End(xlUp).Row + 1
            .Range("A2:A" & Lr).Formula = "=SUBTOTAL(103,$B$2:B2)"
    
            .Range("A1:V1").AutoFilter Field:=22, Criteria1:="ذكر"
            .Range("A2:T" & Lr - 1).SpecialCells(xlCellTypeVisible).Copy
            Sh.Range("B11").PasteSpecial xlPasteValues
    
            Last = Sh.Cells(Rows.Count, 2).End(xlUp).Row + 6
            Sh.Rows("4:9").Copy Sh.Range("A" & Last)
            
            .Range("A1:V1").AutoFilter Field:=22, Criteria1:="أنثى"
            .Range("A2:T" & Lr - 1).SpecialCells(xlCellTypeVisible).Copy
            Sh.Range("B" & Last + 7).PasteSpecial xlPasteValues
        End With
    
        With Sh
            .Range("K5") = .Range("M2")
            .Range("L5") = "بنون"
            .Range("M5") = Application.WorksheetFunction.CountA(.Range("B11:B" & Last - 6))
    
            .Range("K" & Last + 1) = .Range("M2")
            .Range("L" & Last + 1) = "بنات"
            .Range("M" & Last + 1) = Application.WorksheetFunction.CountA(.Range("B" & Last + 7 & ":B" & .Cells(Rows.Count, 2).End(xlUp).Row))
            
            .Range("B11:U" & Last - 6).Borders.Value = 1
            .Range("B" & Last + 7 & ":U" & .Cells(Rows.Count, 2).End(xlUp).Row).Borders.Value = 1
        End With
        
        Application.DisplayAlerts = False
            sSheet.Delete
        Application.DisplayAlerts = True
        
        Application.Goto Sh.Range("M2")
        Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

تحميل الملف المرفق من هنا

الأستاذ / محمد الدسوقى · سبتمبر 10, 2016

أخى الفاضل / ياسر

تسلم دماغك .. حل جميل و أكثر من رائع ... جعلك الله عنوانًا مميزًا فى هذا الصرح التعليمى العظيم

وتقبل وافر احترامى وتقديرى

أبو يوسف النجار · سبتمبر 10, 2016

مستر / ياسر

تشرفت بزيارتك للموضوع كالعادة تسلم وتسلم دماغك ( ربنا ما يحرمنا منك )

الأستاذ محمد الدسوقى اسم الشيت أدرجته بملفى بنفس اسمك حتى أتذكرك شكرا جزيلا

تم تعديل سبتمبر 10, 2016 بواسطه أبو يوسف النجار

تسجيل الدخول

سؤال في سجل فصل بنين ثم بنات حسب خلية

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

أبو يوسف النجار

أبو يوسف النجار

ابراهيم الحداد

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

أبو يوسف النجار

زيزو العجوز

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

أبو يوسف النجار

أبو يوسف النجار

قلم-الاكسل(عبدالعزيز)

أبو يوسف النجار

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

أبو يوسف النجار

الأستاذ / محمد الدسوقى

أبو يوسف النجار

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

الأستاذ / محمد الدسوقى

أبو يوسف النجار

Join the conversation

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

تصفح الموقع

تصفح جديد الموقع

Support

Important Information