mselmy قام بنشر يناير 12, 2012 قام بنشر يناير 12, 2012 الاخوه الاعزاء مرفق ملف اكسيل مطلوب عمل كود ترحيل به بالشكل المرفق فى الملف ولكم جزيل الشكر سجل الحضور.rar
عبدالله المجرب قام بنشر يناير 12, 2012 قام بنشر يناير 12, 2012 السلام عليكم جرب هذا الكود Sub Abu_Ahmed() Dim CL As Range, C As Range, Ce As Range For Each CL In Sheet2.[C3:O3] If CL.Value = [C2] Then For Each C In [B4:B9] For Each Ce In Sheet2.[B4:B12] If C.Value = Ce.Value And C.Offset(0, 1).Value = 1 Then Sheet2.Cells(Ce.Row, CL.Column) = "لم يحضر" End If If C.Value = Ce.Value And C.Offset(0, 1).Value = "" Then Sheet2.Cells(Ce.Row, CL.Column) = "حضر" End If Next Next End If Next End Sub
mselmy قام بنشر يناير 12, 2012 الكاتب قام بنشر يناير 12, 2012 لكن فيه مشكله بسيطه لما وسعت الرنج شوية كتب حضر فى الفراغ ولم يتوقف عند اخر صف فيه طلبه وشكرا
عبدالله المجرب قام بنشر يناير 12, 2012 قام بنشر يناير 12, 2012 جرب هذا التعديل Sub Abu_Ahmed() Dim CL As Range, C As Range, Ce As Range LR = Range("B" & Rows.Count).End(xlUp).Row For Each CL In Sheet2.[C3:O3] If CL.Value = [C2] Then For Each C In [B4:B50] For Each Ce In Sheet2.[B4:B60] If C.Row = LR Then Exit Sub If C.Value = Ce.Value And C.Offset(0, 1).Value = 1 Then Sheet2.Cells(Ce.Row, CL.Column) = "لم يحضر" End If If C.Value = Ce.Value And C.Offset(0, 1).Value = "" Then Sheet2.Cells(Ce.Row, CL.Column) = "حضر" End If Next Next End If Next End Sub
خالد القدس قام بنشر يناير 12, 2012 قام بنشر يناير 12, 2012 السلام عليكم رائع استاذ عبدالله بارك الله فيك
mselmy قام بنشر يناير 13, 2012 الكاتب قام بنشر يناير 13, 2012 شكرا على الاهتمام لكن الترجيل توقف بعد الطالب الاول و عند ترك الخلبيه الاولى خاليه يقوم بالترحيل للفراغات
mselmy قام بنشر يناير 13, 2012 الكاتب قام بنشر يناير 13, 2012 استادى العزيز عبد الله اشكرك شكرا جزيلا هلى اهتمامك لقد قمت بعمل تعديل على الكود الاول والحمد لله اوفى بالغرض واليك الكود Sub Abu_Ahmed() Dim CL As Range, C As Range, Ce As Range For Each CL In Sheet2.[C3:O3] If CL.Value = [C2] Then For Each C In [b4:B30] For Each Ce In Sheet2.[b4:B30] If C.Value = Ce.Value And C.Offset(0, 1).Value = 1 And C.Value <> "" Then Sheet2.Cells(Ce.Row, CL.Column) = "ÛíÇÈ" End If If C.Value = Ce.Value And C.Offset(0, 1).Value = "" And C.Value <> "" Then Sheet2.Cells(Ce.Row, CL.Column) = "íÖÑ" End If Next Next End If Next End Sub
abouelhassan قام بنشر يناير 13, 2012 قام بنشر يناير 13, 2012 لؤلؤ والماظ استاذنا الرائع عبدالله المجرب(ابواحمد) الله يرضى عليك امين
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.