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

[عامر ياسر]

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

المطلوب عمل إحصائية في شيت إحصاء العمر واخذ البيانات من شيت بيانات أساسية

............تم تعديل الملف لوجود خطأ بسيط

 

aamir.xlsm

تم تعديل يوليو 8, 2018 بواسطه عامر ياسر

[Ali Mohamed Ali]

تفضل أخى الكريم

 

احصاء عدد التلاميذ المسجلين حسب الصف والجنس والعمر.xlsm

[عامر ياسر]

26 دقائق مضت, ali mohamed ali said:

تفضل أخى الكريم

 

احصاء عدد التلاميذ المسجلين حسب الصف والجنس والعمر.xlsm

جزاك الله خيرا ً أستاذ ali mohamed ali وجعل الله هذا العمل في ميزان حسناتك 

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

بعد اذن اخي علي 

هذا الملف (تم تفيير بعض الاشياء في الملف لحسن عمل الكود)

الكود

Option Explicit

Sub filter_me()
If ActiveSheet.Name <> "احصاء العمر" Then GoTo Leave_Me_Alone
Application.ScreenUpdating = False
ActiveSheet.Range("b5:I20").ClearContents
Dim clas_arr()
Dim s%, k%, m%, n%
m = 2: n = 3
ReDim clas_arr(1 To 4)
clas_arr(1) = "الاول": clas_arr(2) = "الثاني"
clas_arr(3) = "الثالث": clas_arr(4) = "الرابع"
 For s = 1 To 4
   For k = 5 To 20
        Range("filter_range").AutoFilter Field:=10, Criteria1:=k
        Range("filter_range").AutoFilter Field:=7, Criteria1:="=" & clas_arr(s)
        Range("filter_range").AutoFilter Field:=5, Criteria1:="ذكر"
           Cells(k, m) = Sheets("بيانات أساسية").Cells(1, "M").Value
        Range("filter_range").AutoFilter Field:=10, Criteria1:=k
        Range("filter_range").AutoFilter Field:=7, Criteria1:="=" & clas_arr(s)
        Range("filter_range").AutoFilter Field:=5, Criteria1:="انثى"
            Cells(k, n) = Sheets("بيانات أساسية").Cells(1, "M").Value
   Next
   m = m + 2: n = n + 2
 Next
Leave_Me_Alone:
Erase clas_arr
Range("filter_range").AutoFilter
Application.ScreenUpdating = True
End Sub

الملف مرفق

 

salim_filter.xlsm

[عامر ياسر]

لقد قمت بحله بطريقة ثانية ما هو رأيك بالحل 

aamir.xlsm

[عامر ياسر]

لقد قمت بحله بطريقة ثانية ما هو رأيك بالحل 

aamir.xlsm

ابدعت أستاذ سليم حاصبيا  انا عاشق لـ الاكواد  شكرا لك  

19 دقائق مضت, سليم حاصبيا said:

بعد اذن اخي علي 

هذا الملف (تم تفيير بعض الاشياء في الملف لحسن عمل الكود)

الكود

Option Explicit

Sub filter_me()
If ActiveSheet.Name <> "احصاء العمر" Then GoTo Leave_Me_Alone
Application.ScreenUpdating = False
ActiveSheet.Range("b5:I20").ClearContents
Dim clas_arr()
Dim s%, k%, m%, n%
m = 2: n = 3
ReDim clas_arr(1 To 4)
clas_arr(1) = "الاول": clas_arr(2) = "الثاني"
clas_arr(3) = "الثالث": clas_arr(4) = "الرابع"
 For s = 1 To 4
   For k = 5 To 20
        Range("filter_range").AutoFilter Field:=10, Criteria1:=k
        Range("filter_range").AutoFilter Field:=7, Criteria1:="=" & clas_arr(s)
        Range("filter_range").AutoFilter Field:=5, Criteria1:="ذكر"
           Cells(k, m) = Sheets("بيانات أساسية").Cells(1, "M").Value
        Range("filter_range").AutoFilter Field:=10, Criteria1:=k
        Range("filter_range").AutoFilter Field:=7, Criteria1:="=" & clas_arr(s)
        Range("filter_range").AutoFilter Field:=5, Criteria1:="انثى"
            Cells(k, n) = Sheets("بيانات أساسية").Cells(1, "M").Value
   Next
   m = m + 2: n = n + 2
 Next
Leave_Me_Alone:
Erase clas_arr
Range("filter_range").AutoFilter
Application.ScreenUpdating = True
End Sub

الملف مرفق

 

salim_filter.xlsm

ابدعت أستاذ سليم حاصبيا  انا عاشق لـ الاكواد  شكرا لك  

[عامر ياسر]

أستاذ سليم حاصبيا ارجو مساعدتي في موضوع سابق 

استدعاء بيانات من شيتين ومن اعمده بعيده ووضعها في شيت الترحيل

 

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

لاحظ المعادلة التي ادرجتها لك في الصفحة "بيانات أساسية" العامود G

لا لزوم للمعادلة التي كانت (طويلة و مرهقة للاكسل و تتطلب عامود اضافي)

=MID($D5,1,SEARCH("-",$D5)-1)

بالنسية للموضوع ستدعاء بيانات من شيتين ومن اعمده بعيده ووضعها في شيت الترحيل سافكر بالامر لاحقاً (حسب الوقت)

[عامر ياسر]

2 دقائق مضت, سليم حاصبيا said:

لاحظ المعادلة التي ادرجتها لك في الصفحة "بيانات أساسية" العامود G

لا لزوم للمعادلة التي كانت (طويلة و مرهقة للاكسل و تتطلب عامود اضافي)

=MID($D5,1,SEARCH("-",$D5)-1)

بالنسية للموضوع ستدعاء بيانات من شيتين ومن اعمده بعيده ووضعها في شيت الترحيل سافكر بالامر لاحقاً (حسب الوقت)

نعم لاحظت ذلك وقمت بتغير المعادلة جزيل الشكر 

وبالنسبة للموضوع الثاني على راحتك وشكرا لك في الحالتين ان قمت بالحل او لم تقم بالحل ( جزيل الشكر )

[Ali Mohamed Ali]

أحسنت استاذ عامر طالما انه أعطى النتيجة المرجوة -انت معلم كده يا استاذى الكريم -بارك الله فيك من تقدم الى تقدم ان شاء الله

أما بالنسبة لأستاذنا الكبير سليم دائما مبدع

كود رائع وأدى المطلوب منه على أكمل وجه-جزاك الله كل خير وفرج عنك كربات الدنيا والأخرة كما تفرج كربات الناس ووسع الله فى رزقك ونور بصيرتك وزادك الله من علمه

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

 

 

[Ali Mohamed Ali]

ملحوظة صغيرة: من فضلك وبعد اذن حضرتك أستاذى عامر ياسر

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

جزاك الله كل خير -والحمد لله الذى بنعمته تتم الصالحات

 

[عامر ياسر]

3 دقائق مضت, ali mohamed ali said:

أحسنت استاذ عامر طالما انه أعطى النتيجة المرجوة -انت معلم كده يا استاذى الكريم -بارك الله فيك من تقدم الى تقدم ان شاء الله

أما بالنسبة لأستاذنا الكبير سليم دائما مبدع

كود رائع وأدى المطلوب منه على أكمل وجه-جزاك الله كل خير وفرج عنك كربات الدنيا والأخرة كما تفرج كربات الناس ووسع الله فى رزقك ونور بصيرتك وزادك الله من علمه

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

 

 

احسن الله لك اساذ علي منكم نتعلم انتم أساتذة رائعون بمعنى الكلمة استفدت كثيرا من هذا الصرح الكبير انتم كرماء بعطاءكم وزادكم الله علما ً قوق علمكم مني كل الاحترام والتقدير لحضرتك وكلماتك الرائعة وهي دافع لي