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

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

قام بنشر

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

أخي في الخلية 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

تم تعديل بواسطه فضل 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

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

الأخ / فضل 1

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

أ / يحيى حسين

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

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

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

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

واليك المرفق

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

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

السلام عليكم

اخي فضل

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


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

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

قام بنشر

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

أخي في الخلية 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

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

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

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

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

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

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

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

تم تعديل بواسطه 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

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

السلام عليكم

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


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

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

احسنت

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

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

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

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

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

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

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

قام بنشر

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

اما بعد

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

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

اكتشفت

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

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

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

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

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

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

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

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

قام بنشر

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

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

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

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

أخوك بن علية

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

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

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

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

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

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

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

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

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

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

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

تم تعديل بواسطه فضل 1
قام بنشر

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

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

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

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

Important Information