اذهب الي المحتوي
أوفيسنا

تغيير مرحلة الطالب بشرط النجاح للاعلى في نفس الخلية


إذهب إلى أفضل إجابة Solved by سليم حاصبيا,

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

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

الترحيل لمرحلة اعلى بعد النجاح.xlsx

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

  • أفضل إجابة

اولاَ    الملف يجب ان يحتوي على قليل من البيانات وليس اكثر من 1500 صف (انه نموذج وليس الملف الخقيقي)

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

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

رابعاً   تم ادراج مثال عما تريد في صفحتين     الاولى للبيانات السابقة (Salim) والثانية للبيانات المحدثة (Final)

تم اخفاء بعض الاعمدة وليس حذفها لرؤية النتيجة فقط

الكود

Option Explicit

Sub From_To()
  Dim S As Worksheet, F As Worksheet
  Dim Ro%, RofC%, rofAJ%, I%, Str$
  Dim Dict As Object

  Set S = Sheets("Salim"): Set F = Sheets("Final")
  Set Dict = CreateObject("Scripting.Dictionary")

Ro = S.Cells(Rows.Count, 3).End(3).Row
RofC = F.Cells(Rows.Count, 3).End(3).Row
rofAJ = F.Cells(Rows.Count, "Aj").End(3).Row
F.Range("C11:C" & RofC).ClearContents
F.Range("AJ11:Aj" & rofAJ).ClearContents


 For I = 11 To Ro
  Select Case Trim(Range("AJ" & I))
   Case "الاول": Str = "الثاني"
   Case "الثاني": Str = "الثالث"
   Case "الثالث": Str = "الرابع"
   Case "الرابع": Str = "الخامس"
   Case "الخامس": Str = "السادس"
   Case "السادس": Str = "يرحل للثانوي"
   Case Else: Str = "To Coll"
   End Select
   If Range("AK" & I) = "ناجح" Then
      Dict(Range("C" & I).Value) = Trim(Str)
   Else
      Dict(Range("C" & I).Value) = Range("AJ" & I).Value
   End If
 Next
  F.Range("C11").Resize(Dict.Count) = _
   Application.Transpose(Dict.keys)
  F.Range("Aj11").Resize(Dict.Count) = _
   Application.Transpose(Dict.items)
   Set Dict = Nothing: Set S = Nothing
   
End Sub

الملف مرفق

من صف لاخر.xlsm

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

رائع استاذ سليم جزاكم الله خيرا

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

ويحفظكم من كل سوء

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

وعندي ملاحظة اذا ممكن واتسع لديكم الوقت بان يكون التغيير في شيت واحد لان هذا الشيت هو قاعدة بيانات ثابته للطلبة لسنوات

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

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

لكم وافر احترامي وتقديري

من صف لاخر.xlsm

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

بالنسبة لبقية البيانات ممكن عمل ذلك بواسطة معادلة بسيطة في الخلية  D11 من الشيت Final

=IF($C11="","",INDEX(Salim!D$11:D$100,MATCH($C11,Salim!$C$11:$C$100,0)))

لا حظ الملف

بعد تنفيذ الماكرو يمكن  توقفيه (بواسطة الفاصلة العليا)  واخفاء شيت  Salim   وأعادة    تسمية  شيت final   الى اي اسم اخر لتكون مرجعاً

و بذلك تبقى شيت Salim (مع الماكرو بداخلها)  للتعديلات او الاضافات تعود اليها في وقت الحاجة

 

من صف لاخر 2.xlsm

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

دائما مبدع استاذ سليم وفقكم الله

ما تفضلت به صحيح واحيانا تغيب الفكرة لكن بوجود الطيبين والخبراء في المنتدى وانت منهم

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

لكم وافر الاحترام والتقدير

  • 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