طلب في كنترول مدرسي

جماااال · يناير 7, 2014

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

1- أوائل نصف العام وآخر العام

2- نسب نصف العام وأخر العام

3- ترحيل الطلاب إلى شيت الدور الثانى وآخر العام

4- ترحيل الناجح والراسب

5- ترحيل الطلاب الراسبون إلى شيت توقيع الطلاب

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

وفى النهاية أكون ممتن لحضراتكم على سعة صدركم ولكم من كل الشكر

صف أول 2014.rar

**محمد ابو البـراء** · يناير 8, 2014

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

بارك الله فيك لقيامك بهذا العمل والذي بإذن الله سيكون مميزاً في المستقبل

ولكن ما ساقوم به الان هو مساعدة من نوع اخر

وهو على طريقة لا تعطني سمكة ولكن علمني كيف اصتادها

1 ) عليك ان تبدا استاذي الكريم خطوة خطوة

بمعني انك عليك الان ان تختار ما قام به عمالقة المنتدى من اعمال الكنترول وتعمل عليه

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

2 ) عليك ان تعرف ان فكرة الشيت هي فكرة سهلة تحتاج الى بعض التفكير

وثانياً التعلم

وثالثاً سؤال اخواننا من لا يبخلون علينا بالاجابة

3 ) والان مرحلة التعليم

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

أ) وهو كيفية استخراج الاوائل من اي جدول

خذ هذا الموضوع مميز

http://www.officena.net/ib/?showtopic=38931

ب ) نسبة المادة والاحصائية

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

عدد الناجحين في 100 على عدد الطلبة

والسؤال كيف نعرف عدد الناجحين

الاجابة بدالة counif

وهي تعني اخرج عدد بشرط

وهنا قمت بعمل مثال على مادة العربي في شيت نصف العام

فذهبت في اي خلية فارغة ووضعت هذه المعادلة

=COUNTIF(K8:K98;">49")

والمعادلة تعني اخرج عدد الذين اكبر من حصلوا على 49 درجة

والنتيجة ظهرت بشخص واحد فقط اي 1 فقط هو الناجح

بعد ذلك نستطيع معرفة الاحصائية بالمعادلة الرياضية السابقة

وهي عدد الناجحين =1

في 100

على عدد الطلبة

=الخلية التى قمنا بها من قبل لمعرفة عدد الناجحين*100/عدد الطلبة

----------------------------------

وللتعرف اكثر على دالة countif

شرح بض الاخوة

http://www.youtube.com/watch?v=AaBRzH4KRU8

-----------------------------

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

تم تعديل يناير 8, 2014 بواسطه محمد ابو البـراء

حسين شاكر · يناير 8, 2014

الاخ محمد 28 مجهود عظيم الدال على الخير كفاعلة اكرمك الله

**محمد ابو البـراء** · يناير 8, 2014

وجزاك أخي الكريم استاذ /حسين شاكر

واتمني ان يكون الشرح مبسط ومفهوم

وانا في خدمتك وفي خدمة اي من اخواني

**محمد ابو البـراء** · يناير 8, 2014

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

وهذا الطلب رقم ( 1 )

عمل اوائل نصف وأخر العام

في المرفقات

صف أول 1.rar

تم تعديل يناير 8, 2014 بواسطه محمد ابو البـراء

جماااال · يناير 10, 2014

أخى العزيز / محمد 28

أشكرك على ردك الجميل ومعذرة للتأخير لوجود عطل فى النت تبعى ولك كل الشكر وأرجو التكملة وأكون عاجز عن الشكر

**محمد ابو البـراء** · يناير 10, 2014

أخى العزيز / محمد 28

أشكرك على ردك الجميل ومعذرة للتأخير لوجود عطل فى النت تبعى ولك كل الشكر وأرجو التكملة وأكون عاجز عن الشكر

جزاك الله خيراً وجاري تجهيز الشرح لمعرفة كيفية استخراج النسب كما تريد في شيت حضرتك خطوة ...خطوة!

**محمد ابو البـراء** · يناير 11, 2014

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

مرحباً مجدداً

وبعد

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

وهذه أول مشاركة في هذا الموضوع ( النسب )

وقبل ان انسى احب ان اشكر كل من ساهم في فكري

------------------

وبما اننا وكما قلت لك في مجال تعليمي وليس تنفيذي للمطلوب

فسوف اخبرك باهم الدوال المستخدمة لتنفيذ الطلبات

1 – ففي ورقة الاحصائية وفي الجدول الاعلي والذي عنوانه إحصاء نسب المواد للفصل الدراسى الاول للعام 2014/2013م

وفي اول مربع به

والخاص بالمقيدون من الطلبة بنون وبنات نحتاج الى

المقيدون من البنون
المقيدون من البنات
جملة

الحل :

لحل نقطة 1

نحتاج الى قاعدة countif

والمدى الخاص في شيت حضرتك

=COUNTIF(B5:B95;"=1")

والمقصود بها اجمع كل من هو رقم 1 في العمود b والذي قمت حضرتك بتخصيصة فى ورقة ادخال البيانات بنوع التلميذ

وكذلك

لحل النقطة رقم

2 بنفس الطريقة ولكن سنغير ما في المعادلة السابقة الرقم 1 ب الرقم 2 لتكون هكذا

=COUNTIF(B5:B95;"=2")

اما بالنسبة لحل نقطة رقم 3

فهي عن طريق الجمع بين النقطة رقم 1و2

--------------------

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

1-بنون

2- بنات

3 - الجملة

الحل :

فهي تحل بهذه المصفوفات

1 ) للبنون

=SUM(IF('إدخال البيانات'!B5:B95=1;IF('تقويم فصل دراسى أول'!J3:J93="غ";1;0)))

والمقصود بها اجمع كل من كانت الخلية فيه في نشاط واحد في التقويمات غ ولكن بشرط ان يكون في ورقة ادخال البيانات نوعه ذكر

ملحوظة : عند تنفيذ المصفوفة لا نضغط على enter فقط ولكن نضغط على

Enter+shift+ctrl

2 ) وبالنسبة للبنات

ستحل بنفس الطريقة ولكن سنغير 1 ب 2 كما في هذه المعادلة

=SUM(IF('إدخال البيانات'!B5:B95=2;IF('تقويم فصل دراسى أول'!J3:J93="غ";1;0)))

3 ) واما بالنسبة للجملة

ستحل بالجمع بين البنون والبنات

------------------

والان نرجع الى المربع الثاني وهو الخاص بالحاضرون

الحل :

فسنقوم بطرح بنون المقيدون من بنون الغائبون

وهكذا للبنات وهكذا للجملة

----------------------

أما بالنسبة للمربع الرابع

فهي ستحل بنفس المعادلة

=SUM(IF('إدخال البيانات'!B5:B95= 1 ;IF('تقويم فصل دراسى أول'!J3:J93="غ";1;0)))

ولكن سنغير هذه الجملة "غ"=بـــــــــــــــــ >=.5 *450

وهكذا للبنات ولكن لا ننسى ان نغير ال 1 برقم 2 في الجزء الاول من المعادلة

اما بالنسبة للمربع الخامس ( برنامج علاجي ) فانا لم افهم المقصود

اما بالنسبة للجدول السادس

الحل :

1 ) لحل النسبة للبنون

فهو عملية رياضية تحل بهذه المعادلة ( ععد الناحجون * 100 على عدد الطلبة

=G6*100/C6

:G6 وهي تعني عدد الناجحين من البنون

في 100

على

C6 : وهي تعني اجمالى عدد الطلبة

2 ) وهكذا البنات

g7*100/c6=

3 )اما الاجمالي فهو الجمع بين الاثنين

------------------------

اتمنى ان اكون وفقت لايصال المعلومة............. :fff: :fff: :fff: :fff: :fff:

صف أول 1_2.rar

جماااال · يناير 11, 2014

أخى محمد 28 بجد أنا عاجز عن الشكر

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

#NAME؟

kصف أول 2014.rar

**محمد ابو البـراء** · يناير 11, 2014

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

المشكلة

انك لم تضع الكود في المطور

في موديل جديد.....

وهذه طريقة وضع الكود

خطوة ... بخطوة

-----------------------------

---------------

واخيرا انا في خدمتك...

kصف أول 2014.rar

تم تعديل يناير 11, 2014 بواسطه محمد ابو البـراء

**قنديل الصياد** · يناير 11, 2014

بعد اذن اخى الاستاذ / محمد

اليك الملف به الاوائل بطريقة اخرى

kصف أول 2014.rar

تم تعديل يناير 11, 2014 بواسطه قنديل الصياد

**محمد ابو البـراء** · يناير 11, 2014

بعد اذن اخى الاستاذ / محمد

اليك الملف به الاوائل بطريقة اخرى

kصف أول 2014.rar

جزاك الله خيرا أخي قنديل المنتدى/ الاستاذ قنديل الصياد

:fff: :fff: :fff: :fff: :fff:

**جمال الفار** · يناير 12, 2014

السلام عليكم ورحمة الله وبركاته
اخى وحبيبى التقى النقى/ محمد 28

طريقة عملك هى علمنى كيف اصطاد
بارك الله فيك

وجعله فى ميزان حسناتك

جماااال · يناير 12, 2014

تحية شكر وإعزاز لكل الأساتذة الكرام الذين تفضلوا بالرد والإجابة على أسئلتى المتواضعة

بصراحة أنا عاجز عن ايجاد كلمات شكر لحضراتكم فألف شكر

**محمد ابو البـراء** · يناير 12, 2014

السلام عليكم

1) صديقي الغالي استاذ جمال الفار جزاك الله خيراً على التشجيع دائما واسعدني مرورك الكريم

2 ) استاذ جمااااال

أ ) بعتذر عن الملف المرفق الذي وضعته في المشاركة رقم 8 حيث اننى وضعت ملف فارغ

فيه صفحة النسب فارغة دون الحل والمعادلات التي قمت بشرحها

رغم انني كنت انوي ان اضع ملف به حل وتنفيذ ما شرحته في المشاركة

ونظراً لاني خارج البيت فعند كتابة اول مشاركة فسوف اضع الملف المرفق.

ب ) أخي لو كانت الطريقة هذه مملة فلك ذلك وسيتم تنفيذ المطلوب مباشرةً دون شرح.

ج ) في انتظار ردك أخي الكريم... :fff: :fff: :fff: :fff:

تم تعديل يناير 12, 2014 بواسطه محمد ابو البـراء

جماااال · يناير 12, 2014

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

**محمد ابو البـراء** · يناير 12, 2014

بارك الله فيك اسعدني ردك أخي الغالي

ممكن تحدد لي رقم المشاركة التي بها الملف

جماااال · يناير 12, 2014

هذا هو الملف وبه المشكلة

أول 2014.rar

**قنديل الصياد** · يناير 12, 2014

هذا هو الملف وبه المشكلة

الاخ / جمال

اظن انه تم حل مشكلة الاوائل بهذ الملف وقد تم ادراجه قبل ذلك .. الا اذا انك الم تنظر للمشاركة من اساسه

kصف أول 2014.rar

**محمد ابو البـراء** · يناير 12, 2014

اظن انه تم حل مشكلة الاوائل بهذ الملف وقد تم ادراجه قبل ذلك .. الا اذا انك الم تنظر للمشاركة من اساسه

اولاً : كل الشكر والتقدير للاستاذ الغالي الاستاذ قنديل الصياد ولي الشرف لمتابعتك الموضوع

ثانيا : الاستاذ جمااااال لعلك كما قال لك الحبيب قنديل الصياد ويكانك لم تتابع الموضوع جيداً.. فهذه المشكلة تم وضع لها حلول وليس حل!!!!

الحل الاول في المشاركة رقم 10 لي

والحل الثاني في المشاركة رقم 11 لاستاذنا الكبير الاستاذ قنديل الصياد

فاتمني ان تراجع المشاركات جيداً أخي الحبيب..!!

جماااال · يناير 13, 2014

كل عام وجميع الأخوة الأفاضل فى المنتدى الحبيب بألف خير بمناسبة مولد خير البرية محمد صلى الله عليه وسلم دى أولاً

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

**محمد ابو البـراء** · يناير 13, 2014

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

تمااااااااااااااااااااااااااااااااااااااااام

اذا فلنبدا

ولعل هذه المشاركة مراجعة على ما سبق دراسته ( ابتسامة )

أخي بالنسبة لمعادلة اخراج الاوائل اذا اردت ان تعرف كيفية عملها

فهي تنقسم الى جزئين

الجزء الاول الكود وطريقة وضعه ستجدها في المشاركة رقم 10

وهذا هو الكود الذي ستضعه

' Emad Al Hosami
' hosami1@yahoo.com
' Jordan - Amman
' ÏÇáÉ  ÇáÚÔÑÉ ÇáÇæÇÆá   " TOPTEN "

Function TOPTEN(Mark_Table As Range, Cer_Table As Range, RNK As Integer, True_False As Boolean)
Application.ScreenUpdating = False
Dim Rw, i, k As Long
Dim CON As Integer
Dim HOS
Dim ARR
Dim SS
Dim M
Dim S
TOPTEN = "#N/A"
'-------------------------------------------------------------------
If True_False = True Then
ARR = Array("", "ÇáÃæá", "ÇáËÇäí", "ÇáËÇáË", "ÇáÑÇÈÚ" _
, "ÇáÎÇãÓ", "ÇáÓÇÏÓ", "ÇáÓÇÈÚ", "ÇáËÇãä", "ÇáÊÇÓÚ", "ÇáÚÇÔÑ")
For i = 1 To RNK
CON = WorksheetFunction.CountIf(Mark_Table, WorksheetFunction.Large(Mark_Table, i))
HOS = HOS + (1 / CON)
Next i
HOS = WorksheetFunction.Ceiling(HOS, 1)
SS = ""
If RNK = 1 Then GoTo 10
If WorksheetFunction.Large(Mark_Table, RNK) = WorksheetFunction.Large(Mark_Table, RNK - 1) _
Then SS = " ãßÑÑ"
10 TOPTEN = ARR(HOS) & SS
Exit Function
End If
'-------------------------------------------------------------------
For Rw = 1 To Mark_Table.Rows.Count
If WorksheetFunction.Large(Mark_Table, RNK) = Mark_Table.Cells(Rw, 1) Then
CON = WorksheetFunction.CountIf(Mark_Table, WorksheetFunction.Large(Mark_Table, RNK))
If CON = 0 Then
TOPTEN = Cer_Table.Cells(Rw, 1).TeCONt
Exit Function
End If
If CON <> 0 Then
M = M + 1: S = 0
For k = 1 To RNK
If WorksheetFunction.Large(Mark_Table, RNK) = WorksheetFunction.Large(Mark_Table, k) Then S = S + 1
Next k
If S = M Then
TOPTEN = Cer_Table.Cells(Rw, 1).Value
Exit Function
End If
End If
End If
Next Rw
Application.ScreenUpdating = True
End Function


Sub ÇáÇæÇÆá()

End Sub
Sub ÇÎÝÇÁ_ÇáÌáæÓ_ááÇæÇÆá()
'
' ÇÎÝÇÁ_ÇáÌáæÓ_ááÇæÇÆá ãÇßÑæ
'

'
    Columns("B:B").Select
    Selection.EntireColumn.Hidden = True
End Sub
Sub ÇÙåÇÑ_ÇáÌáæÓ_ááÇæÇÆá()
'
' ÇÙåÇÑ_ÇáÌáæÓ_ááÇæÇÆá ãÇßÑæ
'

'
    Columns("A:A").Select
    Selection.EntireColumn.Hidden = False
    Columns("B:B").ColumnWidth = 7.88
End Sub

الجزء الثاني وهو المعادلة

وهي تنقسم الى اربع اجزاء

1 ) نطاق المجموع

2 )نطاق الخلية التى نريد اخراج الاوائل فيها وليكن الاسم او رقم الجلوس او الترتيب

3 )الترتيب المراد من 1 الى 10

4 ) رقم 1 او 0 (ملحوظة تضع رقم 1 في خلية الترتيب فقط

اما باقي الخلايا في الاسم او المجموع او رقم الجلوس فنضع 0)

----------------------------

اتمنى ان تكون وصلت الفكرة وانا في خدمتك...

**قنديل الصياد** · يناير 13, 2014

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

تمااااااااااااااااااااااااااااااااااااااااام

اذا فلنبدا

ولعل هذه المشاركة مراجعة على ما سبق دراسته ( ابتسامة )

أخي بالنسبة لمعادلة اخراج الاوائل اذا اردت ان تعرف كيفية عملها

فهي تنقسم الى جزئين

الجزء الاول الكود وطريقة وضعه ستجدها في المشاركة رقم 10

وهذا هو الكود الذي ستضعه
' Emad Al Hosami
' hosami1@yahoo.com
' Jordan - Amman
' ÏÇáÉ  ÇáÚÔÑÉ ÇáÇæÇÆá   " TOPTEN "

Function TOPTEN(Mark_Table As Range, Cer_Table As Range, RNK As Integer, True_False As Boolean)
Application.ScreenUpdating = False
Dim Rw, i, k As Long
Dim CON As Integer
Dim HOS
Dim ARR
Dim SS
Dim M
Dim S
TOPTEN = "#N/A"
'-------------------------------------------------------------------
If True_False = True Then
ARR = Array("", "ÇáÃæá", "ÇáËÇäí", "ÇáËÇáË", "ÇáÑÇÈÚ" _
, "ÇáÎÇãÓ", "ÇáÓÇÏÓ", "ÇáÓÇÈÚ", "ÇáËÇãä", "ÇáÊÇÓÚ", "ÇáÚÇÔÑ")
For i = 1 To RNK
CON = WorksheetFunction.CountIf(Mark_Table, WorksheetFunction.Large(Mark_Table, i))
HOS = HOS + (1 / CON)
Next i
HOS = WorksheetFunction.Ceiling(HOS, 1)
SS = ""
If RNK = 1 Then GoTo 10
If WorksheetFunction.Large(Mark_Table, RNK) = WorksheetFunction.Large(Mark_Table, RNK - 1) _
Then SS = " ãßÑÑ"
10 TOPTEN = ARR(HOS) & SS
Exit Function
End If
'-------------------------------------------------------------------
For Rw = 1 To Mark_Table.Rows.Count
If WorksheetFunction.Large(Mark_Table, RNK) = Mark_Table.Cells(Rw, 1) Then
CON = WorksheetFunction.CountIf(Mark_Table, WorksheetFunction.Large(Mark_Table, RNK))
If CON = 0 Then
TOPTEN = Cer_Table.Cells(Rw, 1).TeCONt
Exit Function
End If
If CON <> 0 Then
M = M + 1: S = 0
For k = 1 To RNK
If WorksheetFunction.Large(Mark_Table, RNK) = WorksheetFunction.Large(Mark_Table, k) Then S = S + 1
Next k
If S = M Then
TOPTEN = Cer_Table.Cells(Rw, 1).Value
Exit Function
End If
End If
End If
Next Rw
Application.ScreenUpdating = True
End Function


Sub ÇáÇæÇÆá()

End Sub
Sub ÇÎÝÇÁ_ÇáÌáæÓ_ááÇæÇÆá()
'
' ÇÎÝÇÁ_ÇáÌáæÓ_ááÇæÇÆá ãÇßÑæ
'

'
    Columns("B:B").Select
    Selection.EntireColumn.Hidden = True
End Sub
Sub ÇÙåÇÑ_ÇáÌáæÓ_ááÇæÇÆá()
'
' ÇÙåÇÑ_ÇáÌáæÓ_ááÇæÇÆá ãÇßÑæ
'

'
    Columns("A:A").Select
    Selection.EntireColumn.Hidden = False
    Columns("B:B").ColumnWidth = 7.88
End Sub
الجزء الثاني وهو المعادلة

وهي تنقسم الى اربع اجزاء

1 ) نطاق المجموع

2 )نطاق الخلية التى نريد اخراج الاوائل فيها وليكن الاسم او رقم الجلوس او الترتيب

3 )الترتيب المراد من 1 الى 10

4 ) رقم 1 او 0 (ملحوظة تضع رقم 1 في خلية الترتيب فقط

اما باقي الخلايا في الاسم او المجموع او رقم الجلوس فنضع 0)

----------------------------

اتمنى ان تكون وصلت الفكرة وانا في خدمتك...

الاخ الاستاذ / محمد

الكود السابق تظهر كلمات اللغة العربية بشكل مختلف

اليك الكود صحيحا

Function RANKING(X_Mar As Range, Cer_Range As Range, True_False As Boolean)
Application.ScreenUpdating = False
Dim Arr1, Arr2, Arr3
Dim RNK, ss As Integer
Dim TEXT_M As String
Dim TRT
Arr1 = Array("", "الأول", "الثاني", "الثالث", "الرابع", "الخامس", "السادس", "السابع", "الثامن", "التاسع", "العاشر")
Arr2 = Array(" ", "عشر", "العشرون", "الثلاثون", "الاربعون", "الخمسون", "الستون", "السبعون", "الثمانون", "التسعون")
Arr3 = Array(" ", "المائة", "المائتنان", "الثلاثمائة", "الاربعمائة", "الخمسمائة", "الستمائة", "السبعمائة", "الثمانمائة", "التسعمائة")
RNK = X_Mar
RNK = WorksheetFunction.Rank(X_Mar, Cer_Range, 0)
If True_False = True Then RNK = X_Mar
'--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Set MRange = Range(Cells(3, X_Mar.Column), Cells(X_Mar.Row - 1, X_Mar.Column))
If WorksheetFunction.CountIf(Cer_Range, X_Mar) <> 1 And WorksheetFunction.CountIf(MRange, X_Mar) >= 1 Then TEXT_M = " مكرر "
'--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

X1 = Right(RNK, 1): X2 = Left(RNK, 1): X3 = Left(RNK, 1)
If Len(RNK) = 3 Then X2 = Left(Mid(RNK, 2), 1)
'................................
TRT = Arr1(X1) & " و" & Arr2(X2)
If X1 = 0 Then TRT = Arr2(X2)
If X1 = 1 Then TRT = "الحادي و" & Arr2(X2)
If X2 = 1 Then
   TRT = Arr1(X1) & " " & Arr2(X2)
   If X1 = 0 Then TRT = " العاشر "
   If X1 = 1 Then TRT = " الحادي عشر "
End If
'................................
If Len(RNK) = 1 Then RANKING = Arr1(X1) & TEXT_M
If Len(RNK) = 2 Then RANKING = TRT & TEXT_M
If Len(RNK) = 3 Then RANKING = TRT & " بعد " & Arr3(X3) & TEXT_M
If Len(RNK) = 3 And X2 = 0 Then RANKING = Arr1(X1) & " بعد " & Arr3(X3) & TEXT_M
If Len(RNK) = 3 And X1 = 0 And X2 = 0 Then RANKING = Arr3(X3) & TEXT_M
If RNK = 1000 Then RANKING = "الآلــف" & TEXT_M
Application.ScreenUpdating = True
End Function

**محمد ابو البـراء** · يناير 13, 2014

الاخ الاستاذ / محمد
الكود السابق تظهر كلمات اللغة العربية بشكل مختلف

اليك الكود صحيحا

Function RANKING(X_Mar As Range, Cer_Range As Range, True_False As Boolean)

Application.ScreenUpdating = False

Dim Arr1, Arr2, Arr3

Dim RNK, ss As Integer

Dim TEXT_M As String

Dim TRT

Arr1 = Array("", "الأول", "الثاني", "الثالث", "الرابع", "الخامس", "السادس", "السابع", "الثامن", "التاسع", "العاشر")

Arr2 = Array(" ", "عشر", "العشرون", "الثلاثون", "الاربعون", "الخمسون", "الستون", "السبعون", "الثمانون", "التسعون")

Arr3 = Array(" ", "المائة", "المائتنان", "الثلاثمائة", "الاربعمائة", "الخمسمائة", "الستمائة", "السبعمائة", "الثمانمائة", "التسعمائة")

RNK = X_Mar

RNK = WorksheetFunction.Rank(X_Mar, Cer_Range, 0)

If True_False = True Then RNK = X_Mar

'--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

Set MRange = Range(Cells(3, X_Mar.Column), Cells(X_Mar.Row - 1, X_Mar.Column))

If WorksheetFunction.CountIf(Cer_Range, X_Mar) <> 1 And WorksheetFunction.CountIf(MRange, X_Mar) >= 1 Then TEXT_M = " مكرر "

'--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

X1 = Right(RNK, 1): X2 = Left(RNK, 1): X3 = Left(RNK, 1)

If Len(RNK) = 3 Then X2 = Left(Mid(RNK, 2), 1)

'................................

TRT = Arr1(X1) & " و" & Arr2(X2)

If X1 = 0 Then TRT = Arr2(X2)

If X1 = 1 Then TRT = "الحادي و" & Arr2(X2)

If X2 = 1 Then

TRT = Arr1(X1) & " " & Arr2(X2)

If X1 = 0 Then TRT = " العاشر "

If X1 = 1 Then TRT = " الحادي عشر "

End If

'................................

If Len(RNK) = 1 Then RANKING = Arr1(X1) & TEXT_M

If Len(RNK) = 2 Then RANKING = TRT & TEXT_M

If Len(RNK) = 3 Then RANKING = TRT & " بعد " & Arr3(X3) & TEXT_M

If Len(RNK) = 3 And X2 = 0 Then RANKING = Arr1(X1) & " بعد " & Arr3(X3) & TEXT_M

If Len(RNK) = 3 And X1 = 0 And X2 = 0 Then RANKING = Arr3(X3) & TEXT_M

If RNK = 1000 Then RANKING = "الآلــف" & TEXT_M

Application.ScreenUpdating = True

End Function

بارك الله فيك أخي قنديل الصياد على الاهتمام والمتابعة ولكن أخي الكريم هذا الكود (ranking) ليس الذي اقصده وليس الذي قمت به لعمل ترتيب الاوائل ولكن انا استخدمت كود (topten)

وهذا هو الكود الصحيح

' Emad Al Hosami
' hosami1@yahoo.com
' Jordan - Amman
' دالة  العشرة الاوائل   " TOPTEN "

Function TOPTEN(Mark_Table As Range, Cer_Table As Range, RNK As Integer, True_False As Boolean)
Application.ScreenUpdating = False
Dim Rw, i, k As Long
Dim CON As Integer
Dim HOS
Dim ARR
Dim SS
Dim M
Dim S
TOPTEN = "#N/A"
'-------------------------------------------------------------------
If True_False = True Then
ARR = Array("", "الأول", "الثاني", "الثالث", "الرابع" _
, "الخامس", "السادس", "السابع", "الثامن", "التاسع", "العاشر")
For i = 1 To RNK
CON = WorksheetFunction.CountIf(Mark_Table, WorksheetFunction.Large(Mark_Table, i))
HOS = HOS + (1 / CON)
Next i
HOS = WorksheetFunction.Ceiling(HOS, 1)
SS = ""
If RNK = 1 Then GoTo 10
If WorksheetFunction.Large(Mark_Table, RNK) = WorksheetFunction.Large(Mark_Table, RNK - 1) _
Then SS = " مكرر"
10 TOPTEN = ARR(HOS) & SS
Exit Function
End If
'-------------------------------------------------------------------
For Rw = 1 To Mark_Table.Rows.Count
If WorksheetFunction.Large(Mark_Table, RNK) = Mark_Table.Cells(Rw, 1) Then
CON = WorksheetFunction.CountIf(Mark_Table, WorksheetFunction.Large(Mark_Table, RNK))
If CON = 0 Then
TOPTEN = Cer_Table.Cells(Rw, 1).TeCONt
Exit Function
End If
If CON <> 0 Then
M = M + 1: S = 0
For k = 1 To RNK
If WorksheetFunction.Large(Mark_Table, RNK) = WorksheetFunction.Large(Mark_Table, k) Then S = S + 1
Next k
If S = M Then
TOPTEN = Cer_Table.Cells(Rw, 1).Value
Exit Function
End If
End If
End If
Next Rw
Application.ScreenUpdating = True
End Function

جماااال · يناير 13, 2014

مشكور على هذا العرض وتم تنفيذه وأتت النتائج ايجابية فلكم كل الشكر

تسجيل الدخول

طلب في كنترول مدرسي

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

رابط هذا التعليق

شارك

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

محمد ابو البـراء

حسين شاكر

قنديل الصياد

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

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

Important Information