برجاء المساعدة بكود او بمعادلة لاستخراج المكرر لكل اسمين مع بعض

[فضل حسين]

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

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

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

استخراج المكرر لكل اسمين معا.rar

[فضل حسين]

للرفع

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

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

أخي الكريم، في الحقيقة كنت أنتظر أخي الحبيب أبو أحمد لحل المسألة بالأكواد، وقد حضّرت الحل بالمرفق باستعمال المعادلات غير أنني لم أستطع ذلك بمعادلة واحدة بل وقد استعنت بمعادلات في عدة أعمدة إضافية للوصول إلى المطلوب (أراها ضرورية)... ثم إن هذه المعادلات لا تراعي ترتيب الأشخاص في اللجنة الواحدة إذ لا تعتبر التكرار في حالة ما إذا كان مثلا : محمد1 ومحمد2 بهذا الترتيب في لجنة معينة، وكان محمد2 و محمد1 بهذا الترتيب في لجنة أخرى... أعتقد أن الحل بالأكواد يكون أكثر نجاعة منه بالمعادلات...

المهم أقدم لك في الملف المرفق ما توصلت إليه باستعمال المعادلات في انتظار ما يقدمه أخي الحبيب أبو أحمد أو أحد غيره بالأكواد أو بمعادلات أبسط من التي اقترحتها...

أخوك بن علية

استخراج المكرر لكل اسمين معا.rar

[فضل حسين]

اخى العزيز المبدع والجميل / بن علية

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

شاكر لك ياحبيبى مرورك الكريم على المشاركة وشاكر لك ياحبيبى على حلك الرائع والافكار الجميلة الموجودة فى المعادلات للوصول للحل .

الحل رائع وجميل ولكن يؤخذ عليه الملحوظة التى سيادتك اوضحتها بمشاركتك .

المبدع والجميل بن علية

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

ياحبيبى يامبدع

[طارق محمود]

السلام عليكم

أخي فضل

بعد إذن أستاذنا العظيم بن عليه (بارك الله فيه وجزاه خيرا)

تفضل المرفق بالأكواد

استخراج المكرر لكل اسمين معا.rar

[طارق محمود]

السلام عليكم

أخي فضل

أرجو تبديل الرقم 2 بالرقم 3 في الجزء الأخير من الكود

r = r + 2 تستبدل إلي r = r + 3

في السطر الحادي عشر من الأسفل

ليكون الكود كالتالي

Sub repeated()

With Application: .Calculation = xlCalculationManual: .ScreenUpdating = False: End With


Dim L(99), nam(9, 99) As Variant


i = 1

L(i) = Cells(2, "B")


' تصفية اللجان

For r = 3 To [B10000].End(xlUp).Row

    For c = 1 To i

        If Cells(r, "B") = L(c) Then GoTo 10

    Next c

    i = i + 1

    L(i) = Cells(r, "B")

10

Next r

L_Count = i ' عدد اللجان


For exam = 1 To 5

    s_r = (exam - 1) * 42 + 2    'Start Row

    e_r = s_r + 41              'End Row

    For r = s_r To e_r Step 2

        For i = 1 To L_Count

            If Cells(r, "B") = L(i) Then j = i: GoTo 20

        Next i

20     nam(exam, j) = "(" & Cells(r, "A") & ") + (" & Cells(r + 1, "A") & ")"

    Next r

Next exam


' Compare

r = 1

For exam = 1 To 4

    For i = 1 To L_Count - 1

        For j = exam + 1 To 5

            For n_i = 1 To L_Count

                If IsEmpty(nam(exam, i)) Or IsEmpty(nam(j, n_i)) Then GoTo 30

                If nam(exam, i) = nam(j, n_i) Then

                    r = r + 3

                    Cells(r, "E") = L(i) & " بالإمتحان " & exam: Cells(r, "D") = nam(exam, i)

                    Cells(r + 1, "E") = L(n_i) & " بالإمتحان " & j: Cells(r + 1, "D") = nam(j, n_i)

                End If

30          Next n_i

       Next j

    Next i

Next exam


With Application: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True: End With

End Sub

[فضل حسين]

البشمهندس طارق محمود

ايه يابشمهندس الجمال ده وايه الروعة دى وايه العظمة دى وايه الابداع ده وايه وايه الى مالانهاية ........

كود هندسى رائع من مهندس عبقرى رائع .فعلا خبراء وعظماء حقا فى منتدى اوفيسنا .

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

بس الغلابة امثالنا يابشمهندس اللى بيتعلموا من عظماء وخبراء هذا المنتدى العظيم ومن امثالهم سيادتك

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

فارجو من سيادتك شرح ولو بسيط وتوضيح الفكرة للكود

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

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

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

أخي الكريم، أولا أشكر أخي الكريم طارق على الكود الجميل والرائع جازاه الله عنا خير الجزاء وبارك الله له في علمه وحفظه من كل سوء... وثانيا تم إضافة عمودين آخرين للملف بالمعادلات مع تغيير في إحدى المعادلات لحل المشكلة السابقة (حجز الأسماء بترتيبين مختلفين)... الكل في الملف المرفق....

أخوك بن علية

استخراج المكرر لكل اسمين معا_3.rar

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

الاستاذ الفاضل بن عليه

الاستاذ الفاضل طارق

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

[طارق محمود]

السلام عليكم

أخي الغالي / بن عليه

أخي الغالي / عبد الله

أشكركم كل الشكر

أخي العزيز/ فضل ، جزاك الله خيرا وفضلك الله

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

مرفق الملف مع بعض الشرح

استخراج المكرر لكل اسمين معا مع الشرح.rar

[فضل حسين]

الف شكر لعظماء هذا المنتدى العظيم

استاذنا الكبير المبدع / بن علية

البشمهندس / طارق محمود

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

وكل الحب والتقدير والاجلال والاحترام لكل خبراء واعضاء هذا المنتدى العظيم . وجزا الله الجميع كل خير .

[المبروك]

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

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

ااسف على التأخير في الاطلاع على الموضوع لعدم وجود انترنت

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

غير انني افضل المعادلات عن الاكواد لانني لا اعرف العمل مع الاكواد نهائيا

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

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