ترحيل غياب الطلاب حسب أسمائهم

[بور أحمد]

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

إخواني أسعدكم الله في الدنيا والآخرة ..

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

والورقة الثانية : أحدد التاريخ المطلوب وأرقام الطلاب المتغيبين 

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

آمل مساعدتي في ذلك .. والله يجزيكم كل خير ...

              مرفق ملف للعمل ..

الطلاب.xlsx

[هادى محمد المامون سالم]

السلام عليكم .... ستجد الحل ان شاء الله بالملف المرفق

Find Date.xls

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

بعد إذن الاستاذ هادى (بدون اكواد)

Nour_ahmad.xlsx

[بور أحمد]

يعطيك العافية أستاذ هادي ..    يعطيك العافية أستاذ سليم .. 

وبارك الله فيكم جميعاً ..

اللي أحتاجه هي العملية العكسية لعملكم وفقكم الله

فأنا أحتاج أسجل أرقام الطلاب في الشيت الثاني وبعد الضغط على الزر يرحل لي الغياب إلى الشيت الأول في نفس التاريخ للطالب .

بمعنى ( يضع لي حرف " غ " في تقاطع الصف (اسم الطالب )  مع عمود ( التاريخ ) )

وفقكم الله وسامحوني ..

 

 

 

[هادى محمد المامون سالم]

السلام عليكم

تم التعديل كما هو مطلوب

مرفق الملف بعد التعديل

Find Date 01.xls

[بور أحمد]

وعليكم السلام أستاذ هادي

هذا ما أريده الله يسعدك

لكن هناك مشكلة بعد تسجيل الغياب في عمود 

واختيار تاريخ آخر ليوم جديد وتسجيل الغياب فيه يقوم بمسح الغياب لليوم السابق .

أريد أن تبقى الغيابات كما هي للعمود ( التاريخ )  الذي رحلت بياناته ، ولا تمسح عند تسجيل غياب ليوم آخر

سامحنا أتعبناك أسعدك البارئ

[هانى محمد]

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

  ' Sheets(MY_SH).Range("E5:AR11").ClearContents

 

[هادى محمد المامون سالم]

صح الكلام

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

جرب هذا الماكرو     فقط اكنب رقم الطالب  في B  فيظهر اسمه  في C ثم اكتب "غ" اينما تريد
(أو امسح الــ "غ"  اذا اردت تعديل ذلك) ثم اضغظ الزر Run 
لا تثم بالترقيم في العامود  A  لانه يدرج الترقيم اوتومانيكياً

Option Explicit

Sub Get_abscent()
Dim S1 As Worksheet, S2 As Worksheet
Dim Horz As Range, Vert As Range
Dim M%, i%, y%, X%
Set S1 = SHEET1: Set S2 = SHEET2
M = Application.Max(S2.Range("A6").Resize(100)) + 4
Set Vert = S1.Range("E4:AS4").Find(S2.Range("E2"), lookat:=1)
 If Vert Is Nothing Then Exit Sub
  y = Vert.Column
  For i = 5 To M
      Set Horz = S1.Range("C4:C100"). _
       Find(S2.Range("B" & i), lookat:=1)
       If Not Horz Is Nothing Then
          X = Horz.Row
          S1.Cells(X, y) = S2.Cells(i, "D")
          S1.Cells(X, y).Interior.ColorIndex = _
          IIf(S2.Cells(i, "D") = "", xlNone, 6)
      End If
  Next
   Set S1 = Nothing: Set S2 = Nothing
   Set Horz = Nothing: Set Vert = Nothing
End Sub

الملف مرفق

Nour_Vise_versa.xlsm

[بور أحمد]

يعطيكم العافية جميعاً ..

ولا حرمكم الله الأجر والفضل ...  شكراً لكم من القلب