اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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


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

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

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

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

أخوك بن علية

استخراج المكرر لكل اسمين معا.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

رابط هذا التعليق
شارك

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

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

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

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

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

رابط هذا التعليق
شارك

  • 6 months later...

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

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

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

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

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

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

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

رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



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

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

Important Information