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

[مصطفى محمود مصطفى]

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

الترحيل لمرحلة اعلى بعد النجاح.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

[مصطفى محمود مصطفى]

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

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

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

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

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

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

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

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

من صف لاخر.xlsm

تم تعديل مارس 13, 2020 بواسطه مصطفى محمود مصطفى

[سليم حاصبيا]

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

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

لا حظ الملف

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

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

 

من صف لاخر 2.xlsm

[مصطفى محمود مصطفى]

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

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

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

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

[قصي]

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