برجاء المساعدة بمعادلة لاستخراج اكبر ثلاث مجاميع طبقا لشروط محددة

[فضل حسين]

الى خبراء واعضاء منتداى العزيز والعظيم

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

مرفق الملف موضح به المطلوب ........ وجزاكم الله كل خير

اكبر ثلاث مجاميع.rar

[يحيى حسين]

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

أخي في الخلية K7 ضع المعادلة التالية و هي معادلة صفيف *

=INDEX(A$2:A$23,SMALL(IF($D$2:$D$23=LARGE(IF($B$2:$B$23=$N$3,IF($C$2:$C$23=$N$4,$D$2:$D$23)),ROWS($N$7:N7)),IF($B$2:$B$23=$N$3,IF($C$2:$C$23=$N$4,ROW($A$2:$A$23)-ROW($A$2)+1))),COUNTIF($N$6:N6,LARGE(IF($B$2:$B$23=$N$3,IF($C$2:$C$23=$N$4,$D$2:$D$23)),ROWS($N$7:N7)))+1))

* معادلة الصفيف يجب الضغط على Ctrl+Shift+Enter

ثم قم بسحبها للأسفل و اليمين

دمتم في حفظ الله

[فضل حسين]

ملك المعادلات

الاستاذ الكبير / يحيى حسين

انه لشرف كبير بالنسبة لى بأن تقوم سيادتك بالرد على مشاركة خاصة بى . فأنت استاذ كبير نتعلم منك ونعتز ونفتخر بسيادتك .

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

قمت بنسخ المعادلة وضغط على ctrl +shift +enter لانها معادلة صفيف . ولكن للاسف او لشئ انا بالطبع اجهله لم تقوم المعادلة بأخراج المطلوب

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

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

والف شكر

اكبر ثلاث مجاميع1.rar

تم تعديل فبراير 18, 2012 بواسطه فضل 1

[عبدالله المجرب]

السلام عليكم

اخي فضل

جرب هذا الكود (ضعه في زر أمر)

Sub Abu_Ahmed()

On Error Resume Next

Application.ScreenUpdating = False

w = 7

For Each cl In [B2:B23]

If cl = [N3] And cl.Offset(0, 1) = [N4] Then

MyArr = MyArr & Trim(cl.Offset(0, -1)) & ","

End If

Next

If MyArr = Empty Then GoTo 1

For Each c In Split(Mid(MyArr, 1, Len(MyArr) - 1), ",")

Cells(w, 11) = c

Cells(w, 12) = [N3]

Cells(w, 13) = [N4]

Cells(w, 14) = Application.VLookup(c, [A2:D23], 4, 0)

w = w + 1

Next

LR = [K1000].End(xlUp).Row

Range(Cells(6, "K"), Cells(LR, "N")).Sort Key1:=Cells(6, "N"), Order1:=xlDescending, Header:=xlGuess, _

OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

If LR < 10 Then LR = 10

Range("K10:N" & LR).ClearContents

1:

Application.ScreenUpdating = True

End Sub

[يحيى حسين]

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

جزاك الله اخي الحبيب كل خير على كلماتك الطيبة

و مرفق ملف به حلي و حل الاخ الحبيب عبدالله

اكبر ثلاث مجاميع.rar

[رجب جاويش]

الأخ / فضل 1

من حظك الجميل وجود ابداعين من استاذين كبيرين

أ / يحيى حسين

أ / عبد الله المجرب

وبالنسبة لمعادلة الاستاذ / يحيى تعمل تمام

ومرفق الملف الخاص بتوضيح ذلك بعد

سحبت الدالة الى الخلايا المطلوبة

واليك المرفق

اكبر ثلاث مجاميع1.rar

تم تعديل فبراير 18, 2012 بواسطه ragab100100

[Ahmed Elbhiry]

السلام عليكم

اخي فضل

جرب هذا الكود (ضعه في زر أمر)

Sub Abu_Ahmed()

On Error Resume Next

Application.ScreenUpdating = False

w = 7

For Each cl In [B2:B23]

If cl = [N3] And cl.Offset(0, 1) = [N4] Then

MyArr = MyArr & Trim(cl.Offset(0, -1)) & ","

End If

Next

If MyArr = Empty Then GoTo 1

For Each c In Split(Mid(MyArr, 1, Len(MyArr) - 1), ",")

Cells(w, 11) = c

Cells(w, 12) = [N3]

Cells(w, 13) = [N4]

Cells(w, 14) = Application.VLookup(c, [A2:D23], 4, 0)

w = w + 1

Next

LR = [K1000].End(xlUp).Row

Range(Cells(6, "K"), Cells(LR, "N")).Sort Key1:=Cells(6, "N"), Order1:=xlDescending, Header:=xlGuess, _

OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

If LR < 10 Then LR = 10

Range("K10:N" & LR).ClearContents

1:

Application.ScreenUpdating = True

End Sub

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

[Ahmed Elbhiry]

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

أخي في الخلية K7 ضع المعادلة التالية و هي معادلة صفيف *

=INDEX(A$2:A$23,SMALL(IF($D$2:$D$23=LARGE(IF($B$2:$B$23=$N$3,IF($C$2:$C$23=$N$4,$D$2:$D$23)),ROWS($N$7:N7)),IF($B$2:$B$23=$N$3,IF($C$2:$C$23=$N$4,ROW($A$2:$A$23)-ROW($A$2)+1))),COUNTIF($N$6:N6,LARGE(IF($B$2:$B$23=$N$3,IF($C$2:$C$23=$N$4,$D$2:$D$23)),ROWS($N$7:N7)))+1))

* معادلة الصفيف يجب الضغط على Ctrl+Shift+Enter

ثم قم بسحبها للأسفل و اليمين

دمتم في حفظ الله

ممتاز اخى يحيى مطلوب اضافة جزء للمعادلة بحيث ان العدد الحدد لم يكمل الخانات الثلاث يتركه فاضى

[عبدالله المجرب]

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

ما فهمت اخي احمد

[Ahmed Elbhiry]

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

ما فهمت اخي احمد

غير الارقام من 200 / 51الى 200/ 52 وجرب وتابع الناتج سوف ياتى بارقام للمدرسة غبر المحدد

تم تعديل فبراير 18, 2012 بواسطه Ahmed Elbhiry

[عبدالله المجرب]

اخي احمد

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

[فضل حسين]

الاستاذ الكبير / يحيى حسين

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

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

حبيب قلبى المايسترو

وحشتنى ياحبيبى ووحشنى الحانك ووحشنى اعمال الرائعة . يارب تكون ياحبيبى بخير فى اتم صحة واحسن حال يارب . فأنت حبيبى يامايسترو والله اعلم .

بس ياحبيبى الكود بتاعك او اللحن بتاعك اسمحلى او استئذن من سيادتك بأن يكون

1- ان يظهر اكبر 10مجاميع وليس ثلاثة

2- اظهار رسالة message box بانه يوجد خطأ فى حالة كتابة رقم المدرسة وكتابة رقم القسم مخالف او غير موجود للرقم المدرسة . بمعنى اننى

لو كتبت رقم المدرسة 100 وكتبت رقم القسم 51 مثلا . تعطى رسالة بان رقم القسم غير موجود لهذه المدرسة فرجاء تصحيح الخطأ هذا فى نص الرسالة .

حبيب قلبى المايسترو مننتظر لحنك الجميل لاستمتع به .

فى النهاية صدقونى انا بعتبر نفسى محظوظ فعلا انا محظوظ جدا محظوظ بوجودى معكم ومع العمالقة امثال استاذنا الكبير / يحيى حسين وحبيب قلبى المايسترو ووجود فى هذا المنتدى العظيم بكل خبراءه واعضائه . الحمد لله لهذه النعمة وادعوا الله ان يديمها .

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

[فضل حسين]

للرفع

[عبدالله المجرب]

السلام عليكم

جرب التعديل التالي

Sub Abu_Ahmed()

On Error Resume Next

Application.ScreenUpdating = False

Range("K7:N100").ClearContents

w = 7

For Each cl In [B2:B23]

If cl = [N3] And cl.Offset(0, 1) = [N4] Then

MyArr = MyArr & Trim(cl.Offset(0, -1)) & ","

End If

Next

If MyArr = Empty Then MsgBox "رقم القسم غير موجود لهذه المدرسة فرجاء تصحيح الخطأ ", vbOKOnly, "تنبيه": GoTo 1

For Each c In Split(Mid(MyArr, 1, Len(MyArr) - 1), ",")

Cells(w, 11) = c

Cells(w, 12) = [N3]

Cells(w, 13) = [N4]

Cells(w, 14) = Application.VLookup(c, [A2:D23], 4, 0)

w = w + 1

Next

LR = [K1000].End(xlUp).Row

Range(Cells(6, "K"), Cells(LR, "N")).Sort Key1:=Cells(6, "N"), Order1:=xlDescending, Header:=xlGuess, _

OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

1:

Application.ScreenUpdating = True

End Sub

[Ahmed Elbhiry]

السلام عليكم

جرب التعديل التالي

Sub Abu_Ahmed()

On Error Resume Next

Application.ScreenUpdating = False

Range("K7:N100").ClearContents

w = 7

For Each cl In [B2:B23]

If cl = [N3] And cl.Offset(0, 1) = [N4] Then

MyArr = MyArr & Trim(cl.Offset(0, -1)) & ","

End If

Next

If MyArr = Empty Then MsgBox "رقم القسم غير موجود لهذه المدرسة فرجاء تصحيح الخطأ ", vbOKOnly, "تنبيه": GoTo 1

For Each c In Split(Mid(MyArr, 1, Len(MyArr) - 1), ",")

Cells(w, 11) = c

Cells(w, 12) = [N3]

Cells(w, 13) = [N4]

Cells(w, 14) = Application.VLookup(c, [A2:D23], 4, 0)

w = w + 1

Next

LR = [K1000].End(xlUp).Row

Range(Cells(6, "K"), Cells(LR, "N")).Sort Key1:=Cells(6, "N"), Order1:=xlDescending, Header:=xlGuess, _

OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

1:

Application.ScreenUpdating = True

End Sub

الله ينور عليك ابااحمد كده تمام 100/100

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

احسنت

تم تعديل فبراير 19, 2012 بواسطه Ahmed Elbhiry

[فضل حسين]

حبيب قلبى المايسترو

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

بس قبل ماانهى هذه المشاركة عايز اقولك حاجة . والله بكل حب والله يعلم . بسم الله وماشاء الله والله اكبر وانا ماسك الخشب

(انت اصبحت ملكش حل واصبحت الحانك عالمية) .

انتظر ردى قريبا ان شاء الله

سلام ياحبيبى يامايسترو

[عبدالله المجرب]

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

اخي فضل

اخجلتم تواضعي وهذا بعض ما عندكم

شكراً لكل هذا المدح والتشجيع

[Ahmed Elbhiry]

انت اهل لذلك ابو أحمد

[فضل حسين]

حبيب قلبى المايسترو

اما بعد

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

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

اكتشفت

وبكل اسف ان هذة السيمفونية الابداعية الجميلة ينقصها شئى مهم جدا جدا جدا جدا جدا ااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااا .

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

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

حبيب قلبى المايسترو

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

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

فى انتظار رد سيادتك .

اكبر ثلاث مجاميع.rar

[بن علية حاجي]

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

أخي الكريم، بعد إذن أخي الحبيب أبو أحمد، أضيف لمسة للسمفونية حسب اللحن الجديد وهذه اللمسة تتمثل بإدراج السطر التالي في الكود:

Range(Cells(17, "K"), Cells(LR, "N")) = Empty

الذي يقوم بإفراغ كل البيانات المرحلة بعد الفلترة بداية من السطر 17 للاحتفاظ بعشر بيانات الأولى (أكبر 10 مجاميع لا غير)... أرجو أن يكون هذا الحل البسيط مقبولا... في الملف المرفق تجد التعديل...

أخوك بن علية

اكبر عشرة مجاميع.rar

[عبدالله المجرب]

استاذ بن علية

هذا هو ما كنت ساقوم به بالضبط

سلمت يمينك

[فضل حسين]

حبيب قلبى المايسترو

عمل عظيم من شخصية عظيمة . الف شكر ياحبيبى واعذرنى او سامحنى عن جهلى . وجعلك الله عونا وزخرا ومعلما لامثالى .

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

بارك الله فيك وفى امثالك تعلمنا منك الكثير ومازلنا نتعلم . الف مليون شكر .

الاستاذ الكبير / بن عليه

استاذى صاحب الهدوء الجميل الذى يعمل فى صمت . ويعطى دائما الخلاصة فى كلمتين وبس .

سعدت جدا بمرورك الكريم جزاك الله كل خير يااستاذى ياكبير .

ودائما تمتعنا بحلولك وربنا يخليك لنا ويبارك فيك .

الف شكر للعملقين ونتقابل ان شاء الله فى مشاركات اخرى لنتعلم ونستمتع بأعمالهم .

تم تعديل فبراير 20, 2012 بواسطه فضل 1

[Ahmed Elbhiry]

اجمل مافى المنتدى روح الفريق والتكامل والتفانى من اجل الاخرين وروح الحب الموجوده والاحترام المتبادل

بين اعضاء المنتدى فنشكر الاخ بن عليا والاخ ابو أحمد