اخواني واحبائي أعضاء المنتدى الرجاء المساعدة في توزيع الشفوي

[بوب2016]

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

من ورقة توزيع الشفوي الي شفوي دور أول ..انا بصراحة حاولت واظهرت الاسماء وأرقام الجلوس  والمسلسل

لكن لم تتغير معي اللجان .. اسف للاطالة 

ولكم كل الشكر والتقدير 

تمهيد.rar

[ياسر خليل أبو البراء]

وعليكم السلام أخي الكريم مصطفى

يرجى مزيد من التوضيح ... ما هي ورقة العمل المصدر التي تريد الترحيل منها .. ويفضل أن تكون الورقة الأصلية لا التي فيها معادلات مرتبطة بها (أقصد هل هي ورقة الطالبات والتي أرجحها أن تكون المصدر أم ورقة توزيع الشفوي والتي تحتوي على معادلات)

وما هي الورقة الهدف المراد الترحيل إليها؟

وما هو شرط الترحيل ؟ هل رقم اللجنة فقط ؟أي أنك تقوم بكتابة رقم اللجنة فيتم ترحيل البيانات؟

 

[بوب2016]

اخي الحبيب ياسر السلام عليكم 

* ورقة العمل ( المصدر ) هي ورقة توزيع الشفوي ( عمود E ) وهو رقم لجنة الطالبة 

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

*** كل من هي في لجنة ( 1 ) تكون في  ورقة منفصلة ومن خلال الضغط على زر زيادة ونقصان يتم تغيير الورقة الي لجنة ( 2 ) مع ظهور اسماء الطالبات  لجنة

( 2 ) وهكذا 

 

تمهيد.zip

[الشهابي]

أخي العزيز / بوب 2016

وبعد أذن أستاذنا الكبير وأستاذ الكل / ياسر خليل حفظه الله 

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

ولكن قبل تطبيق الكود قمت بالتعديل في عنواين الأعمدة ( رقم الجلوس ) و ( اسم الطالب ) من أجل أن تكون التسمية نفسها في ورقة المصدر وإلا لن تعمل التصفية 

كما تم إلغاء دمج صفوف عناوين الأعمدة لتكون في صف واحد فقط لأنه مع الدمج لن يعمل الكود 

إن شاء الله يلبي هذا طلبك 

تقبل تحياتي

تمهيد.zip

[ابراهيم الحداد]

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

ارجو من الله عز وجل ان يكون هو ذا المراد

تمهيد.rar

[ياسر خليل أبو البراء]

أخي الكريم مصطفى إليك الكود على الرابط التالي

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

بعد وضع الكود في موديول عادي قم بعمل كليك يمين على الزر الموجود لديك باسم Spinner 1  ثم اختر الأمر Assign Macro واختر اسم الإجراء المسمى Transfer_Data_Using_Loops

الرابط من هنا

أرجو أن يفي بالغرض إن شاء الله

تقبل تحياتي

[بوب2016]

عزيزي العضو ( المحترف جدااااااااااااااااااااااا ) / الشهابي

الله يزيدك علم ونور  ، حفظك الله ايه الجمال ده والعبقرية  .. فعلا المنتدى ده قمة الروعة بالقائمين عليه وأعضائة الكرام 

اشكرك يا باشمهندس الشهابي واشكر استاذي الدكتور ياسر خليل من كل أعضاء المنتدى 

[الشهابي]

أخي العزيز / بوب 2016

أرجع إلى حل الأستاذ القدير / زيزو العجوز حفظه الله

فهو أفضل  فهو لم يغير شيء في الملف

[ياسر خليل أبو البراء]

بارك الله فيك أخي الغالي الشهابي .. وجزيت خيراً

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

 

يبدو أنني قدمت أصعب الحلول وأطولها طريقاً .. المهم أن المطلوب تم على خير وبحمد الله يا مستر بوب

[بوب2016]

الان شاهدت رد الاستاذ /  زيزو  وردك  ورد الاستاذ ياسر ايضا الجديد  لضعف النت عندي 

يااااارب يعزكم جميعا وبارك الله فيكم وحفظم الله من كل شر 

 

37 دقائق مضت, زيزو العجوز said:

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

ارجو من الله عز وجل ان يكون هو ذا المراد

تمهيد.rar

استاذي الفاضل الاخ / زيزو  ..

السلام عليكم  ورحمة الله بارك الله فيك انت و الاستاذ الشهابي والسيد العزيز / ياسر  اشكر حضرتك اسف للتأخير في الرد لاني لم اشاهد  رسالتك  لضعف النت  عندي 

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

سامحوني على التقصير 

30 دقائق مضت, ياسر خليل أبو البراء said:

أخي الكريم مصطفى إليك الكود على الرابط التالي

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

بعد وضع الكود في موديول عادي قم بعمل كليك يمين على الزر الموجود لديك باسم Spinner 1  ثم اختر الأمر Assign Macro واختر اسم الإجراء المسمى Transfer_Data_Using_Loops

الرابط من هنا

أرجو أن يفي بالغرض إن شاء الله

تقبل تحياتي

تقبل مني كل احترامي لك وتقديري انت والاخ المحترم / زيزو و الاخ  الفاضل /الشهابي 

تم تعديل سبتمبر 2, 2016 بواسطه بوب2016
اضافة

[بوب2016]

2 ساعات مضت, ياسر خليل أبو البراء said:

بارك الله فيك أخي الغالي الشهابي .. وجزيت خيراً

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

 

يبدو أنني قدمت أصعب الحلول وأطولها طريقاً .. المهم أن المطلوب تم على خير وبحمد الله يا مستر بوب

الاخ المحترم العزيز / ياسر خليل 

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

حاولت رفع شيت الكنترول كله ..وجدت مساحته7 ميجا 

[ابراهيم الحداد]

الحمد لله الذى تتم بنعمته الصالحات

[بوب2016]

اخي الكريم /  زيزو ..

اولا اسف على الازعاج..هناك مشكلة عندما نسخت ( توزيع الشفوي و شفوي ترم أول ) بكل الابعاد الصفوف والاعمدة الي شيت الكنترول ( 7 M ) لا يعمل التوزيع  الا اذا فتح ملف التمهيد 

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

مع الشكر لكم جميعا

 

تجربة1.rar

تمهيد.rar

[الشهابي]

أخي العزيز / بوب 2016

السبب لتغير تسمية الأوراق في الملف حيث تغيرت الورقة باسم (توزيع  الشفوي ) إلى ورقة 1 بدلا من ورقة 19 في الملف ( تمهيد ) 

المهم تم نقل كود الأستاذ القدير زيزو  جزاه الله خير 

و العفو 

تجربة1.rar

[ياسر خليل أبو البراء]

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

أمر آخر لابد أن تتعلمة وهو أنه عندما يحدث خطأ .. تنقر على زر الأمر Debug فيظهر معك سطر باللون الأصفر قم بنسخه ووضعه في المشاركة لنعرف أين حدثت المشكلة بالضبط

[بوب2016]

    Sheets("توزيع الشفوي").Range("B5:E295").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Range("K1:K2"), CopyToRange:=Range("B13:C13"), Unique:= _
        False

كل الكود ده بالاصفر

[بوب2016]

يا جماعة انا عملت العملية بس المريض كان مصيف لوحده .. هههههه

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

[ياسر خليل أبو البراء]

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

دائماً لما يكون فيه ملفات كتير في الموضوع يرجى الإشارة إلى الملف الذي به المشكلة ...

وبردو مصمم متشتلغش بالكود اللي شرحتهولك رغم إني مفصله !! (أصلي بحب شغلانة الترزي عشان جدي كان ترزي .. الله برحمه ويغفر له)

 

[بوب2016]

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

ليه الموقع لا يرفع ملف 7 M  > امانة عليك تكتب لي الكود عشان الدنيا دخلت معايا في بعضها 

انا كتبت الكود ده بس متضحك علي ...هههههههههه اخذته بكل ما فيه 

Sub لجان()
  'إلغاء تحديث الشاشة لتسريع عمل الكود
    Application.ScreenUpdating = False

    'مسح نطاق النتائج في الورقة الهدف لوضع البيانات المرحلة مع كل تنفيذ للكود
    Sh.Range("B14:C300").ClearContents

    'حلقة تكرارية من الصف رقم 6 في الورقة المصدر إلى آخر صف
    For I = 6 To wsLast
    
        'اختبار ما إذا كانت الخلية في الورقة المصدر في العمود الخامس
        'تساوي قيمة خلية شرط الترحيل فإذا تحقق الشرط
        If Ws.Cells(I, 5).Value = Crit Then
        
            'يتم ترحيل البيانات رقم الجلوس والاسم من الورقة المصدر إلى الورقة الهدف
            'الجملة تبدأ بالورقة الهدف حيث أول تعامل سيكون مع الصف رقم 14 في العمود الثاني
            'لتمديد النطاق ليشمل خلية أخرى في نفس الصف [Resize] وتستخدم كلمة
            '[B14:C14] أي أنه في أول حلقة تكرارية سيشار إلى الخلايا
            'بعد علامة يساوي نساوي قيم الخلايا بقيم الخلايا في ورقة المصدر
            '[C6:D6] وهنا بعد علامة يساوي نشير إلى الخلايا
            Sh.Cells(iRow, 2).Resize(1, 2).Value = Ws.Cells(I, 3).Resize(1, 2).Value

            'بعد الترحيل يتم زيادة مقدار المتغير بمقدار 1 للانتقال
            'إلى الصف التالي وهو هنا في أول حلقة كان الصف 14 فيزيد
            'بمقدار واحد ليصبح المتغير بقيمة 15 أي أن التعامل
            'في الحلقة التالية سيكون مع الصف رقم 15 لوضع نتائج جديدة
            iRow = iRow + 1

        'نهاية جملة الشرط الذي يساوي الخلية بشرط الترحيل
        End If

    'الانتقال للحلقة التالية أي الصف التالي وهو هنا سيكون
    'الصف السابع في ورقة المصدر أي الورقة التي يتم الترحيل منها
    Next I

    'بنفس أول قيمة وضعت له في الكود [iRow] إذا ظل المتغير المسمى
    'هذا يعني أنه لم تتم عملية ترحيل واحدة حيث أن المتغير لا يزيد إلا
    'إذا تحقق الشرط الموجود داخل الحلقات التكرارية ، ومن ثم فهذا
    'يعني أنه لم تتم عمليات ترحيل فنظهر رسالة للمستخدم تفيد بذلك
    If iRow = 14 Then MsgBox "No Data In This Class", vbExclamation

    'استعادة خاصية تحديث الشاشة
    Application.ScreenUpdating = True
End Sub
 

()لجانSub

      
   Sheets("توزيع الشفوي").Range("B5:E295").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Range("K1:K2"), CopyToRange:=Range("B13:C13"), Unique:= _
        False
   
    
End Sub

[ياسر خليل أبو البراء]

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

وبعدين يا إما تشتغل على الكود الأول أو الكود الثاني (الاتنين مع بعض مينفعش) ..

الرجاء إرفاق ملفك وتحديد الكود المطلوب ..هل تريد الأول أم الثاني؟

ويرجى وضع الأكواد بين أقواس الكود لتظهر بشكل منضبط ... ساعد نفسك في إتمام موضوعك بشكل لائق

[بوب2016]

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

اخدت الملف الذي ارسله الاستاذ زيزو الله يكرمه  و اضفت عليه باقي العمل والشيتات  

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

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

برنامج كامل للكنترول والكمال لله وحده 

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

[ياسر خليل أبو البراء]

وعليكم السلام ياأخي مصطفى

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

ونحن لا ننزعج أبداً من الطلبات إنما نريد أن يتعلم الأعضاء لنرتقي سوياً .. فربما في يوم تكون أفضل من الجميع ، وعندها ستقدم لهم بمثل ما قدموا لك ، وفي جميع الحالات الكل مستفيد .. فنحن حلقة واحدة مترابطة وفريق واحد ، وهذا ما يميزنا

تقبل تحياتي

[قلم-الاكسل(عبدالعزيز)]

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