جماااال قام بنشر يناير 7, 2014 قام بنشر يناير 7, 2014 اخوتى فى المنتدى المحبوب لقد جربت شيتات كثيرة ولأن أغلبها لا يتناسب مع شيت الإدارة لقد قمت بهذا العمل المتواضع ولأننى حديث عهد بالأكسيل فإننى أقف عاجز عن تكملة هذا العمل فأرجو مساعدتى على أيجاد وآسف لكثرة المطلوب ولكن على ثقة فى حضراتكم أنكم سوف تلبون مطلبى 1- أوائل نصف العام وآخر العام 2- نسب نصف العام وأخر العام 3- ترحيل الطلاب إلى شيت الدور الثانى وآخر العام 4- ترحيل الناجح والراسب 5- ترحيل الطلاب الراسبون إلى شيت توقيع الطلاب ومرفق نسخة من العمل المطلوب تعديله + صورة لبعض المشكلات التى تقابلنى أثناء العمل وفى النهاية أكون ممتن لحضراتكم على سعة صدركم ولكم من كل الشكر صف أول 2014.rar
محمد ابو البـراء قام بنشر يناير 8, 2014 قام بنشر يناير 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 بواسطه محمد ابو البـراء 3
حسين شاكر قام بنشر يناير 8, 2014 قام بنشر يناير 8, 2014 الاخ محمد 28 مجهود عظيم الدال على الخير كفاعلة اكرمك الله 1
محمد ابو البـراء قام بنشر يناير 8, 2014 قام بنشر يناير 8, 2014 وجزاك أخي الكريم استاذ /حسين شاكر واتمني ان يكون الشرح مبسط ومفهوم وانا في خدمتك وفي خدمة اي من اخواني
محمد ابو البـراء قام بنشر يناير 8, 2014 قام بنشر يناير 8, 2014 (معدل) السلام عليكم ورحمة الله وبركاته وهذا الطلب رقم ( 1 ) عمل اوائل نصف وأخر العام في المرفقات صف أول 1.rar تم تعديل يناير 8, 2014 بواسطه محمد ابو البـراء
جماااال قام بنشر يناير 10, 2014 الكاتب قام بنشر يناير 10, 2014 أخى العزيز / محمد 28 أشكرك على ردك الجميل ومعذرة للتأخير لوجود عطل فى النت تبعى ولك كل الشكر وأرجو التكملة وأكون عاجز عن الشكر
محمد ابو البـراء قام بنشر يناير 10, 2014 قام بنشر يناير 10, 2014 أخى العزيز / محمد 28 أشكرك على ردك الجميل ومعذرة للتأخير لوجود عطل فى النت تبعى ولك كل الشكر وأرجو التكملة وأكون عاجز عن الشكر جزاك الله خيراً وجاري تجهيز الشرح لمعرفة كيفية استخراج النسب كما تريد في شيت حضرتك خطوة ...خطوة!
محمد ابو البـراء قام بنشر يناير 11, 2014 قام بنشر يناير 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 )اما الاجمالي فهو الجمع بين الاثنين ------------------------ اتمنى ان اكون وفقت لايصال المعلومة............. صف أول 1_2.rar
جماااال قام بنشر يناير 11, 2014 الكاتب قام بنشر يناير 11, 2014 أخى محمد 28 بجد أنا عاجز عن الشكر أخى محمد توجد مشكلة فى تنفيذ دالة الأوائل كما فعلت ومرفق صورة بها النتيجة كذلك #NAME؟ kصف أول 2014.rar
محمد ابو البـراء قام بنشر يناير 11, 2014 قام بنشر يناير 11, 2014 (معدل) أخي السلام عليكم ورحمة الله وبركاته المشكلة انك لم تضع الكود في المطور في موديل جديد..... وهذه طريقة وضع الكود خطوة ... بخطوة ----------------------------- --------------- واخيرا انا في خدمتك... kصف أول 2014.rar تم تعديل يناير 11, 2014 بواسطه محمد ابو البـراء
قنديل الصياد قام بنشر يناير 11, 2014 قام بنشر يناير 11, 2014 (معدل) بعد اذن اخى الاستاذ / محمد اليك الملف به الاوائل بطريقة اخرى kصف أول 2014.rar تم تعديل يناير 11, 2014 بواسطه قنديل الصياد 1
محمد ابو البـراء قام بنشر يناير 11, 2014 قام بنشر يناير 11, 2014 بعد اذن اخى الاستاذ / محمد اليك الملف به الاوائل بطريقة اخرى kصف أول 2014.rar جزاك الله خيرا أخي قنديل المنتدى/ الاستاذ قنديل الصياد :fff: :fff:
جمال الفار قام بنشر يناير 12, 2014 قام بنشر يناير 12, 2014 السلام عليكم ورحمة الله وبركاته اخى وحبيبى التقى النقى/ محمد 28 طريقة عملك هى علمنى كيف اصطاد بارك الله فيك وجعله فى ميزان حسناتك 1
جماااال قام بنشر يناير 12, 2014 الكاتب قام بنشر يناير 12, 2014 تحية شكر وإعزاز لكل الأساتذة الكرام الذين تفضلوا بالرد والإجابة على أسئلتى المتواضعة بصراحة أنا عاجز عن ايجاد كلمات شكر لحضراتكم فألف شكر
محمد ابو البـراء قام بنشر يناير 12, 2014 قام بنشر يناير 12, 2014 (معدل) السلام عليكم 1) صديقي الغالي استاذ جمال الفار جزاك الله خيراً على التشجيع دائما واسعدني مرورك الكريم 2 ) استاذ جمااااال أ ) بعتذر عن الملف المرفق الذي وضعته في المشاركة رقم 8 حيث اننى وضعت ملف فارغ فيه صفحة النسب فارغة دون الحل والمعادلات التي قمت بشرحها رغم انني كنت انوي ان اضع ملف به حل وتنفيذ ما شرحته في المشاركة ونظراً لاني خارج البيت فعند كتابة اول مشاركة فسوف اضع الملف المرفق. ب ) أخي لو كانت الطريقة هذه مملة فلك ذلك وسيتم تنفيذ المطلوب مباشرةً دون شرح. ج ) في انتظار ردك أخي الكريم... تم تعديل يناير 12, 2014 بواسطه محمد ابو البـراء 1
جماااال قام بنشر يناير 12, 2014 الكاتب قام بنشر يناير 12, 2014 أخى محمد 28 شرحك ممتاز أرجوك أكمل ولا تتردد ولكن كما قلت لك فى المشاركة التى قام بالرد عليها الأستاذ جمال الفار أنه توجد مشكلة راجع الملف المرفق ولك لك الشكر على مجهودكِ 1
محمد ابو البـراء قام بنشر يناير 12, 2014 قام بنشر يناير 12, 2014 بارك الله فيك اسعدني ردك أخي الغالي ممكن تحدد لي رقم المشاركة التي بها الملف
قنديل الصياد قام بنشر يناير 12, 2014 قام بنشر يناير 12, 2014 هذا هو الملف وبه المشكلة الاخ / جمال اظن انه تم حل مشكلة الاوائل بهذ الملف وقد تم ادراجه قبل ذلك .. الا اذا انك الم تنظر للمشاركة من اساسه kصف أول 2014.rar
محمد ابو البـراء قام بنشر يناير 12, 2014 قام بنشر يناير 12, 2014 اظن انه تم حل مشكلة الاوائل بهذ الملف وقد تم ادراجه قبل ذلك .. الا اذا انك الم تنظر للمشاركة من اساسه اولاً : كل الشكر والتقدير للاستاذ الغالي الاستاذ قنديل الصياد ولي الشرف لمتابعتك الموضوع ثانيا : الاستاذ جمااااال لعلك كما قال لك الحبيب قنديل الصياد ويكانك لم تتابع الموضوع جيداً.. فهذه المشكلة تم وضع لها حلول وليس حل!!!! الحل الاول في المشاركة رقم 10 لي والحل الثاني في المشاركة رقم 11 لاستاذنا الكبير الاستاذ قنديل الصياد فاتمني ان تراجع المشاركات جيداً أخي الحبيب..!!
جماااال قام بنشر يناير 13, 2014 الكاتب قام بنشر يناير 13, 2014 كل عام وجميع الأخوة الأفاضل فى المنتدى الحبيب بألف خير بمناسبة مولد خير البرية محمد صلى الله عليه وسلم دى أولاً ثانياً لقد قرأت مشاركات الأخوة الأفاضل وأنا أريد أن أتعلم كما قلت سابقاً لا تعطنى سمكة ولكن علمنى كيف أصطاد فأنا أقوم بالتجربة فى شيت خارجى كى أتعلم وعندما لم تفلح المحاولات راسلت حضراتكم فانهالت المشاركات فأنا متابع جيد لكل الموضوعات فلكل الأخوة الشكر على اهتمامه الكبير وكل عام وحضراتكم بألف خير
محمد ابو البـراء قام بنشر يناير 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 قام بنشر يناير 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 قام بنشر يناير 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 الكاتب قام بنشر يناير 13, 2014 مشكور على هذا العرض وتم تنفيذه وأتت النتائج ايجابية فلكم كل الشكر
الردود الموصى بها