اذهب الي المحتوي
أوفيسنا

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

قام بنشر

اخى الحبيب المهندس طارق

بعيدا عن المدح والشكر والنفدير فانى احبك فى الله

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

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

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

تقبل الله صومك وسائر اعملا الخير منك ان شاء الله

total.rar

  • الردود 63
  • Created
  • اخر رد

Top Posters In This Topic

قام بنشر

السلام عليكم

أخي الحبيب د/خالد

أحبك الله الذي أحببتني فيه

أخي الموضوع أصعب من ان تنقل الكود وتعدل عليه قليلا

آسف لاأريد إحباطك

ولا أنكر تقدمك الكبير

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

فالأول لابد من الحصول علي هذه المجاميع

لذلك في الأول لابد أن تعمل دالة مجموع

ثم هذه الدالة للحصول علي رتبة هذا المجموع بالنسبة لباقي المجاميع

راجع مثلا الملف المرفق في المشاركة #24 من هذا الموضوع ، وأنت طبعا ادري مني في هذا

لكن لابد أن تتعلم جيدا كل معادلة في الملف قبل أن تحولها أو تحوله إلي دالة أو كود

نقلت لك من هذا الملف في المشاركة #24 معادلة المجموع لتعينك علي عمل الدالة

في المرفق بداية فقط لشرح كيف يعمل الكود

ووضعت فيه الكود الذي أرسلته أنت بأخطاؤه كما هو

تستطيع الإكمال وإكتشاف الأخطاء

مثلا إذا بدأت حلقة For ...Next

لمتغير p فلابد أن يكون آخر الحلقة نفس المتغير وهذا احد أخطاء الكود

أنظر المرفق وحاول ثانية

شرح الكود.rar

قام بنشر

السلام عليكم اخى الحبيب مهندس طارق

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

sphinx12xls.rar

قام بنشر

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

ارجو ان تكون فى اتم الصحة والعافية ورمضان كريم

ارجوك راجع المرفق سوف تجد ان الكود لا يفرق فى عملية الترتيب ويعطى لااكثر من لاعب نفس الترتيب

ارجو ان لا اكون قد اثقلت عليك

سلام عليكم

sphinx11.rar

قام بنشر (معدل)

السلام عليكم

أخي العزيز/ د.خالد

ارجوك راجع المرفق سوف تجد ان الكود لا يفرق فى عملية الترتيب ويعطى لااكثر من لاعب نفس الترتيب

أولا أعذرني لتأخري بالرد عليك

ثانيا من عيوب هذه الدالة أنها تحتاج إلي مايشبه الإنعاش Refresh

مثل الجداول المحورية

ولكنها سليمة وتعمل جيدا

فقط كل ماعليك ان تنعشها وذلك بالوقوف في الخلايا التي بها الدالة من Q4 إلي Q16

وتضغط F2 ثم إنتر لكل خلية منها

وستجد انها تعمل بكفاءة

تم تعديل بواسطه TareQ M
قام بنشر

الف شكر اخى الكريم على المعلومة

وبالفعل هى تعمل كويس جدا

وانا فى انتظار دالة حساب النقاط والمجموعة وسوف اغلق الموضوع حتى لا يزهق بعض الناس ولا اثقل عليك

ولك منى الف شكر وتحية واحترام وتقدير

قام بنشر (معدل)

السلام عليكم

أخي العزيز / Kemas

لاحظت يا إخوة

أن هذا الموضوع طال جدا جدا

وتأتينى رسائل منه يوميا

معذرة لطول وقت الموضوع

مع أن هذا يرجع لعدة عوامل منها

أن الأخ السائل (sphinx) لم يكن يعلم جيدا مايمكن عمله بالإكسل

أنه أيضا كانت له طلبات متغيرة وغير بعضها وعلي فترات متقطعة

لم يتدخل أحد غيري تقريبا للمساعدة في الموضوع في فترات غيابي عنه

كلما فكرت في إغلاق الموضوع ومراسلة السائل فقط ، أجد دائما أعضاء أو زوار يتصفحون الموضوع فأجد نفسي لاأريد أن احرم من يبحث عن العلم

عموما الموضوع كاد أن ينتهي

وكل عام وأنتم بخير

تم تعديل بواسطه TareQ M
قام بنشر (معدل)

السلام عليكم

أخي الحبيب/ د.خالد

أرجو أن تعذرني لتأخري بالرد عليك

هذا هو كود دالة المجموع لوزن 69 أوأقل

Function rnk69(bst, w As Range) As Variant


Dim ss(99), tot(99), tot_mx(99), Asbaqya(99), qur3a(99), Asbaqya_cof(99), z(99) As Variant, st, fn As Range


Set fn = [a1000].End(xlUp)

Set st = fn.End(xlUp)


play_N = WorksheetFunction.CountA(Range(st, fn))


 For p = 1 To play_N

	For i = 1 To 3

 	tot(i) = Cells(st.Row, bst.Column).Offset(p - 1, i - 4)

 	If WorksheetFunction.IsNumber(tot(i)) Then

 	tot(i + 3) = tot(i) + (3 - i) * 0.1

 	Else

 	tot(i + 3) = 0

 	End If


 	If tot_mx(p) < tot(i + 3) Then tot_mx(p) = tot(i + 3)


 	'Asbaqya

 	If tot(i) > "X" Then

 	tot(i + 6) = Right(tot(i), Len(tot(i)) - 1)

 	Else: tot(i + 6) = 0

 	End If

 	If Asbaqya(p) < tot(i + 6) Then Asbaqya(p) = tot(i + 6)

	Next i

 mx_qur3a = WorksheetFunction.Max(Range("A:A"))

 qur3a(p) = (mx_qur3a - Cells(st.Row + p - 1, 1).Value) / mx_qur3a / 100


 If mx_Asbaqya < Asbaqya(p) Then mx_Asbaqya = Asbaqya(p)


 Next p


 'calculate each z(p)

 For p = 1 To play_N

 	wp = Cells(st.Row - 1 + p, w.Column).Value

	If mx_Asbaqya = tot_mx(p) Then

 	Asbaqya_cof(p) = -tot_mx(p) / 4 / wp

	Else: Asbaqya_cof(p) = 0

	End If


	z(p) = (tot_mx(p) + (tot_mx(p) / wp)) + 0.00009 + Asbaqya_cof(p) + qur3a(p)

 Next p


 'calculate Rank of bst

 s = bst.Row - st.Row + 1

 If z(s) < 1 Then tot_rnk = "X": Exit Function


 If w <= 69 Then rnk = 1 Else rnk = 0: GoTo 111 ' assume

 	For p = 1 To play_N

 	wp = Cells(st.Row - 1 + p, w.Column).Value

 	If wp > 69 Then GoTo 100

 	If z(p) > z(s) Then rnk = rnk + 1

100 Next p


111

 	rnk69 = rnk


End Function

ومثله مع تعديل طفبف كود دالة المجموع لوزن 77 أواأكثر

تفضل المرفق وبه لمسات طفيفة للإخراج فقط

sphinx11.rar

تم تعديل بواسطه TareQ M
قام بنشر

السلام عليكم اخى الكريم الحبيب الغالى المهندس طارق

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

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

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

وعموما انا احبك فى الله وماكان لله دام واتصل وارجوك منك المسامحة على الحاحى واثقالى عليك

بارك الله لك واتم عليك رمضان ومتعك بكل خير ونعمة ان شاء الله

قام بنشر

السلام عليكم

أخي الحبيب

لامشاكل

ولابد من توسيع الصدر قليلا

فأخونا Kemas من الأحباب المجتهدين وله جهد واضح وكبير

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

ولضيق الوقت ألغيها بدون قرائتها أحيانا

إلتمس لأخيك ألف عذر

سأغلق الموضوع

وإن ظهر لك أي إستفسار

إرسل عالإميل

أو إفتح موضوع جديد ، كما تحب

وكل عام وأنتم جميعا بخير

قام بنشر

السلام عليكم

الاخوه الكرام

لا مشاكل ولا اى شئ انا مدين الى الله ثم اليكم بكثير من المساعدات التى قدمت لى على ايديكم

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

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

اخى خميس واخى المهندس طارق بارك الله لكما والف الف مليون شكر

زائر
هذا الموضوع مغلق.
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

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



×
×
  • اضف...

Important Information