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

كود استدعاء الناجحين والدور الثاني


إذهب إلى أفضل إجابة Solved by أسامة البراوى,

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

Sub HH_START()
Dim b As Integer, M As Integer
    Sheets("كشف ناجح").Range("c7:m1000").ClearContents
        Sheets("كشف الدور الثاني").Range("c7:m1000").ClearContents
                    M = 7: b = 7
        Application.ScreenUpdating = False
    For R = 1 To 1000
                      If Cells(R, 113) = "ناجح" Then
            Range("A" & R).Range("b1:c1,z1,ai1,ar1,ba1,bl1,bm1,cd1,df1,di1").Copy
            Sheets("كشف ناجح").Range("c" & M).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
            M = M + 1
            End If
            If Cells(R, 113) = "دور ثان في" Then
             Range("A" & R).Range("b1:c1,z1,ai1,ar1,ba1,bl1,bm1,cd1,df1,di1").Copy
            Sheets("كشف الدور الثاني").Range("c" & b).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
            b = b + 1
               End If
    Next
 
    MsgBox ("الحمد لله تـــم ترحيل الناجحين و الراسبين إلى أوراق عمل جديدة ")
    Application.ScreenUpdating = True
End Sub


Range("b1:c1,z1,ai1,ar1,ba1,bl1,bm1,cd1,df1,di1"

لماذا اخترنا هذه الحلايا وخاصه الرقم 1

اخي الكريم القومي

يحفظك الله

لماذا اخترنا هذه الحلايا وخاصه الرقم 1

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

عمود الحاله هو اللي فيه ناجح او دور تان

وعمود ال M  هو اللي هيكون فيه اسماء مواد الدور التاني

اخي الكريم


            If Cells(R, 113) = "دور ثان في" Then

الولد هتكون الكلمه المعيار هي  ..  له دور ثان في

والبنت هتكون كلمة المعيار هي .. لها دور ثان في

فكيف نتصرف في هذه الحاله

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

لولد هتكون الكلمه المعيار هي  ..  له دور ثان في

والبنت هتكون كلمة المعيار هي .. لها دور ثان في

فكيف نتصرف في هذه الحاله من اجل ترحيلهم   ارجوكم

تم تعديل بواسطه سـامي 169
رابط هذا التعليق
شارك

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

 

الولد هتكون الكلمه المعيار هي  ..  له دور ثان في

والبنت هتكون كلمة المعيار هي .. لها دور ثان في

فكيف نتصرف في هذه الحاله من اجل ترحيلهم   ارجوكم

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

أخي الحبيب القومي

جزيت خير الجزاء على هذ الكود الرائع

من روعة الكود وبساطته دفعني لشرح الأسطر لعله يفيد الأخوة الأعضاء خصوصاً العاملين في مجال التربية والتعليم

قمت بتعديلات طفيفة على الكود (لعل الأمر لا يضايقك)

إليكم الكود بالشرح

Sub Nageh_Raseb()
'يقوم الكود بترحيل الناجحين والراسبين في أوراق العمل المخصصة لذلك
'----------------------------------------------------------------
'تعريف المتغيرات
    Dim RowNageh As Long, RowRaseb As Long
    Dim WS As Worksheet, SHNageh As Worksheet, SHRaseb As Worksheet
'تعيين متغيرات أوراق العمل
    Set WS = Sheets("الشيت"): Set SHNageh = Sheets("كشف ناجح"): Set SHRaseb = Sheets("كشف الدور الثاني")
'مسح محتويات النطاق الذي سيتم الترحيل إليه في ورقة الناجحين
    SHNageh.Range("C7:M1000").ClearContents
'مسح محتويات النطاق الذي سيتم الترحيل إليه في ورقة الراسبين
    SHRaseb.Range("C7:M1000").ClearContents
'صف البداية الذي سيتم الترحيل إليه في ورقة الناجحين وورقة الراسبين
    RowNageh = 7: RowRaseb = 7
'إلغاء خاصية اهتزاز الشاشة
    Application.ScreenUpdating = False
'حلقة تكرارية في ورقة البيانات الأساسية بداية من الصف رقم 11 حتى آخر صف
        For R = 11 To WS.Cells(Rows.Count, 1).End(xlUp).Row
'يمثل الرقم 113 رقم العمود الذي به النتيجة في ورقة البيانات الأساسية
'إذا كانت الخلية في الصف المحدد في عمود النتيجة تساوي كلمة ناجح
            If Cells(R, 113) = "ناجح" Then
'نسخ النطاقات المحددة في الصف المحدد في حالة تحقق الشرط
                WS.Range("A" & R).Range("B1:C1,Z1,AI1,AR1,BA1,BL1,BM1,CD1,DI1,DJ1").Copy
'لصق البيانات المنسوخة إلى العمود الثالث في ورقة الناجحين
                SHNageh.Range("C" & RowNageh).PasteSpecial xlPasteValues
'إلغاء خاصية القص والنسخ
                Application.CutCopyMode = False
'زيادة المتغير بمقدار واحد استعداداً لبيانات جديدة
                RowNageh = RowNageh + 1
'إذا كانت الخلية في الصف المحدد في عمود النتيجة تساوي كلمة دور ثان في
            ElseIf Cells(R, 113) = "دور ثان في" Then
'نسخ النطاقات المحددة في الصف المحدد في حالة تحقق الشرط
                WS.Range("A" & R).Range("B1:C1,Z1,AI1,AR1,BA1,BL1,BM1,CD1,DI1,DJ1").Copy
'لصق البيانات المنسوخة إلى العمود الثالث في ورقة الراسبين
                SHRaseb.Range("C" & RowRaseb).PasteSpecial xlPasteValues
'إلغاء خاصية القص والنسخ
                Application.CutCopyMode = False
'زيادة المتغير بمقدار واحد استعداداً لبيانات جديدة
                RowRaseb = RowRaseb + 1
            End If
'الانتقال للصف التالي في ورقة البيانات الأساسية
        Next
'رسالة تفيد بانتهاء عملية الترحيل
        MsgBox ("الحمد لله تم ترحيل الناجحين و الراسبين إلى أوراق عمل جديدة"), vbInformation
'إعادة تفعيل خاصية اهتزاز الشاشة
    Application.ScreenUpdating = True
End Sub

الأخ الفاضل سامي طلبك غير منطقي وغير مفهوم ...

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

وهل الترحيل للأولاد في ورقة عمل منفصلة عن الإناث أم ماذا ؟

 

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

الرجاء التوضيح ثم التوضيح وبالتفصيل إذا أردت فعلاً المساعدة

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

السلام عليكم

انا اظن انه عايز يغير فى العمود الخاص بالنتيجة

وفى الحالة دى ممكن نعدل الشرط للبحث عن جزء من الكلمة "دور ثان"  وسينفذ الكود مهما اضاف قبلها او بعدها (له او لها)

 

 

نضع الكود

ElseIf InStr(1, Cells(R, 113).Value, "دور ثان") Then
         

مكان الكود

ElseIf Cells(R, 113) = "دور ثان في" Then

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

اشكرك اشكرك اشكرك على ردك  استاذ ياسر وبعد

في صفحة الشيت الموجودة بالمرفق وفي عمودال DI  يوجد 3 معايير

المعيار الاول هو كلمه ناجح  .......... ويتم ترحيلهم الى صفحة كشف ناجح مفيش مشكله

المعيار التاني كلمه له دور ثان في .......... ويتم ترحيلهم الى صفخة كشف الدور الثاني مفيش مشكله

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

يجزيكم الله خيرا

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

 

السلام عليكم

انا اظن انه عايز يغير فى العمود الخاص بالنتيجة

وفى الحالة دى ممكن نعدل الشرط للبحث عن جزء من الكلمة "دور ثان"  وسينفذ الكود مهما اضاف قبلها او بعدها (له او لها)

 

 

نضع الكود

ElseIf InStr(1, Cells(R, 113).Value, "دور ثان") Then
         

مكان الكود

ElseIf Cells(R, 113) = "دور ثان في" Then

 استاذ اسامه

صعها في المرفق من فضلك ادام الله عليك الخير

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

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

ارجو شرحها

ElseIf InStr(1, Cells(R, 113).Value, "دور ثان") Then

وعندى سؤال ارجو التكرم بالاجابه عليه

هل يمكن تغيير كود الترحيل هذا الى كود استدعاء

يعني عايز اضع الزر في صفحة كشف الناجح وزر في كشف الدور التاني

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

  • أفضل إجابة

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

اما اذا لم يجد هذا الجزء فالرد برسالة خطأ تعتبر FALSE

 

وبالنسبة للاستدعاء

يجب تعديل الكود

ترحيل مفيد باختبار اعمدة معينة 2.rar

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

أخي الحبيب أسامة لم يقم بأي تغيير في الكود

فقط وضع زر وربطه بالكود في أي ورقة والكود في هذه الحالة يعمل على الورقتين معاً ... ولذلك سألت هل تريد ان يكون كل كود منفصل أم لا؟

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

أخي الكريم

يضايقني جدا المشاركات المتتالية بدون داعي

كان من الممكن أن تكون المشاركة رقم 21 و 22 في مشاركة واحدة

الرجاء الالتزام بالتوجيهات

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

أخي الحبيب أسامة لم يقم بأي تغيير في الكود

فقط وضع زر وربطه بالكود في أي ورقة والكود في هذه الحالة يعمل على الورقتين معاً ... ولذلك سألت هل تريد ان يكون كل كود منفصل أم لا؟

  اخى العزيز ياسر

 

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

(يعنى فيه تغيير فى المرفق)

 

المهم ...

عندى اقتراح ...

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

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

 

1433241222971.jpg

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

اضافه صغيره جدا

وهي الناجحين زي الدور التاني

فيه معيارين

ناجح ...وفيه ناجحه

وعايزهم يستدعوا مع الناجحين

مش عارف اضع الجزئيه السحريه الخاصة بالاستاذ المحترم اسامه

ضعها في مرفق من فضلك

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

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