mselmy قام بنشر يناير 12, 2012 مشاركة قام بنشر يناير 12, 2012 الاخوه الاعزاء مرفق ملف اكسيل مطلوب عمل كود ترحيل به بالشكل المرفق فى الملف ولكم جزيل الشكر سجل الحضور.rar رابط هذا التعليق شارك More sharing options...
عبدالله المجرب قام بنشر يناير 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 رابط هذا التعليق شارك More sharing options...
mselmy قام بنشر يناير 12, 2012 الكاتب مشاركة قام بنشر يناير 12, 2012 تسلم ايدك رابط هذا التعليق شارك More sharing options...
mselmy قام بنشر يناير 12, 2012 الكاتب مشاركة قام بنشر يناير 12, 2012 لكن فيه مشكله بسيطه لما وسعت الرنج شوية كتب حضر فى الفراغ ولم يتوقف عند اخر صف فيه طلبه وشكرا رابط هذا التعليق شارك More sharing options...
عبدالله المجرب قام بنشر يناير 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 رابط هذا التعليق شارك More sharing options...
خالد القدس قام بنشر يناير 12, 2012 مشاركة قام بنشر يناير 12, 2012 السلام عليكم رائع استاذ عبدالله بارك الله فيك رابط هذا التعليق شارك More sharing options...
mselmy قام بنشر يناير 13, 2012 الكاتب مشاركة قام بنشر يناير 13, 2012 شكرا على الاهتمام لكن الترجيل توقف بعد الطالب الاول و عند ترك الخلبيه الاولى خاليه يقوم بالترحيل للفراغات رابط هذا التعليق شارك More sharing options...
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 رابط هذا التعليق شارك More sharing options...
abouelhassan قام بنشر يناير 13, 2012 مشاركة قام بنشر يناير 13, 2012 لؤلؤ والماظ استاذنا الرائع عبدالله المجرب(ابواحمد) الله يرضى عليك امين رابط هذا التعليق شارك More sharing options...
asdhamdey قام بنشر يناير 13, 2012 مشاركة قام بنشر يناير 13, 2012 جزاك الله كل خير استاذ عبد الله رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان