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

المطلوب التعديل على كود الترحيل


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

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

السلام عليكم

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

 

 

 

ترحيل الدور الثاني.rar

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

بارك الله فيك أخي المتألق النجم الساطع أسامة البراوي OB

ملحوظة من أخوك ياسر خليل YK

 

بالنسبة لورقة العمل Sheet6 (تجميعي) في هذا السطر

x = Sheet6.[b1000].End(xlUp).Row

سؤالي هل قمت بإظهار العمود ورؤية محتواه ..المحتوى في العمود غير كامل لآخر البيانات ..متوقف عند الطالب رقم 28 ومن ثم فهناك بيانات أخرى لم يتم التعامل معها

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

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

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

Sub Final()
Sheet7.Range("a6:ak100") = ""
Application.ScreenUpdating = False

x = Sheet6.[G1000].End(xlUp).Row

For t = 11 To x Step 3
y = Sheet7.[A1000].End(xlUp).Row + 1

    If Sheet6.Range("au" & t).Value = "له دور ثان فى" Then
    Sheet7.Range("a" & y) = Sheet6.Range("E" & t).Value
    Sheet7.Range("b" & y) = Sheet6.Range("G" & t).Value
    Sheet7.Range("e" & y & ":ak" & y) = Sheet6.Range("j" & t + 2 & ":ap" & t + 2).Value
Else
End If
Next
Call errase
Application.ScreenUpdating = True
End Sub
تم تعديل بواسطه أسامة البراوى
  • Like 1
رابط هذا التعليق
شارك

اشكركم اخوتي على اهتمامكم اخي اسامة واخي ياسر

 

الخطوة الاولى تمام حيث يتم الترحيل ولكن هناك بعض الملاحظات التي اتمنى ان تاخذها بعين الاعتبار 

وهي :-

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

2- المواد التي نجح فيها الطالب يجب ان ترحل كاملة الاعمال وامتحان الفصلين والمجموع ولقد علمت المواد التي نجح فيها الطالب باللون الاخضر ولم ترحل 

 

وفي الاخر اشكرك اخي

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

بارك الله فيك أخي المتألق النجم الساطع أسامة البراوي OB

ملحوظة من أخوك ياسر خليل YK

 

بالنسبة لورقة العمل Sheet6 (تجميعي) في هذا السطر

x = Sheet6.[b1000].End(xlUp).Row

سؤالي هل قمت بإظهار العمود ورؤية محتواه ..المحتوى في العمود غير كامل لآخر البيانات ..متوقف عند الطالب رقم 28 ومن ثم فهناك بيانات أخرى لم يتم التعامل معها

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

اولا شفاك الله اخي وثانيا لم افهم ملاحظتك اخي بخصوص متوقف عند الطالب 28

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

اشكرك اخي على اهتمامك غلبتك معي بس مازال في خطوة ثالثة وهي 

مواد الرسوب لا يرحل عمود امتحان الفصلين ولا المجموع ترحل اعمال المادة فقط لاننا في انتظار امتحان الدور الثاني لنرصد الامتحان مع الاعمال لنحصل على المجموع

 

 

 نسخة من ترحيل الدور الثاني-OB3.rar

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

اتفضل

 

تم اضافة الكود لكى يقوم بالتالى بعد نقل النتائج

 

1- مسح نتيجة الامتحان

2- تلوين خانات المواد بالون الاصفر

3- اضافة معادلة النتيجة الجديدة (تجمع اعمال السنة مع نتيجة امتحان الدور الثانى - اظن انك قد ترغب فى وضع حد اقصى ليها ....  ابقى بلغنى اعمل لك التعديل)

 

 

ترحيل الدور الثاني-OB4.rar

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

 

السلام عليكم

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

 

 

 

 

ترحيل الدور الثاني-OB4.rar

 

 

 

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

السلام عليكم 

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

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

السلام عليكم 

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

 

يمكنك اضافة السطر ده فى داخل الكود او اضافته فى كود منفصل مع تغيير اسم الشيت (sheet1 ) الى اسم الشيت الذى ترغب فى تنظيفة وتعديل المدى ("a6:ak100") حسب الحاجة

Sub Clear_Colour()
    
    Sheets("sheet1").Range("a6:ak100").Interior.ColorIndex = 0

End Sub

  • Like 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