بوعلام قام بنشر يناير 20, 2012 قام بنشر يناير 20, 2012 السلام عليكم ورحمة الله تعالى وبركاته أنا أعمل على برنامج ولكن لتكرار المعادلات اصبح الملف ثقيلا هل بالامكان استبدال المعادلات بالأكواد وجزاكم الله كل خير الغيابات برنامج.rar
abouelhassan قام بنشر يناير 20, 2012 قام بنشر يناير 20, 2012 تفضل اخى من ابداع الاستاذ ابوتامر احترامى الغيابات برنامج.rar
بوعلام قام بنشر يناير 21, 2012 الكاتب قام بنشر يناير 21, 2012 السلام عليكم ورحمة الله تعالى وبركاته شكرا على سرعة تجاوبك أخي لكن المعادلات لازالت تظهر في الخانات أرجوا الشرح وشكرا
عبدالله المجرب قام بنشر يناير 21, 2012 قام بنشر يناير 21, 2012 السلام عليكم اخي الفاضل قم بمسح جميع معادلات الصفيف في الجدول ثم ضع هذا الكود في زر امر Sub Abu_Ahmed() Dim cl As Range Range("B8:D52").ClearContents Set MyRng = Sheets("البيانات").Range("D8:D17") Application.ScreenUpdating = False For Each cl In MyRng If cl.Value = [B6].Value Then LR = Range("B" & Rows.Count).End(xlUp).Row + 1 Cells(LR, 2) = cl.Offset(0, -1) Cells(LR, 3) = cl.Offset(0, 1) Cells(LR, 4) = cl.Offset(0, 2) End If Next End Sub
بوعلام قام بنشر يناير 21, 2012 الكاتب قام بنشر يناير 21, 2012 السلام عليكم بارك الله فيك أخي أبو أحمد هذا الكود تحفة حقا جعل الله ما تقومون به في ميزان حسناتكم إذاكانت لدي عدة أقسام في الورقة كيف يكون الكود يا ترى وشكرا
بوعلام قام بنشر يناير 21, 2012 الكاتب قام بنشر يناير 21, 2012 السلام عليكم تفضل أخي أبو أحمد جزاك الله كل خير الغيابات برنامج.rar
abouelhassan قام بنشر يناير 21, 2012 قام بنشر يناير 21, 2012 كل الشكر والتقدير استاذنا عبدالله المجرب فوق الرائع اخى هذا الذى ارسلته لحضرتك برنامج للاستاذ ابو تامر لتحويل المعادلات لكود احترامى
بوعلام قام بنشر يناير 22, 2012 الكاتب قام بنشر يناير 22, 2012 كل الشكر والتقدير استاذنا عبدالله المجرب فوق الرائع اخى هذا الذى ارسلته لحضرتك برنامج للاستاذ ابو تامر لتحويل المعادلات لكود احترامى السلام عليكم أخي شكرا على تجاوبك لكنني لم أجد شيئا بالمرفقات حاول ان ترسله لي مرة اخرى
عبدالله المجرب قام بنشر يناير 22, 2012 قام بنشر يناير 22, 2012 السلام عليكم اخي ابوعلام سيصبح الكود هكذا Sub Abu_Ahmed() Dim cl As Range Range("B8:D52,B56:D100,B104:D148,B152:D196,B200:D244").ClearContents Set MyRng = Sheets("البيانات").Range("D8:D1000") Application.ScreenUpdating = False For Each cl In MyRng If cl.Value = [B6].Value Then LR = Cells(52, 2).End(xlUp).Row + 1 Cells(LR, 2) = cl.Offset(0, -1) Cells(LR, 3) = cl.Offset(0, 1) Cells(LR, 4) = cl.Offset(0, 2) End If ' ===== If cl.Value = [B54].Value Then LR = Cells(100, 2).End(xlUp).Row + 1 Cells(LR, 2) = cl.Offset(0, -1) Cells(LR, 3) = cl.Offset(0, 1) Cells(LR, 4) = cl.Offset(0, 2) End If ' ===== If cl.Value = [B102].Value Then LR = Cells(148, 2).End(xlUp).Row + 1 Cells(LR, 2) = cl.Offset(0, -1) Cells(LR, 3) = cl.Offset(0, 1) Cells(LR, 4) = cl.Offset(0, 2) End If ' ===== If cl.Value = [B150].Value Then LR = Cells(196, 2).End(xlUp).Row + 1 Cells(LR, 2) = cl.Offset(0, -1) Cells(LR, 3) = cl.Offset(0, 1) Cells(LR, 4) = cl.Offset(0, 2) End If ' ===== If cl.Value = [B198].Value Then LR = Cells(244, 2).End(xlUp).Row + 1 Cells(LR, 2) = cl.Offset(0, -1) Cells(LR, 3) = cl.Offset(0, 1) Cells(LR, 4) = cl.Offset(0, 2) End If '===== Next End Sub
بوعلام قام بنشر يناير 23, 2012 الكاتب قام بنشر يناير 23, 2012 السلام عليكم ما شاء الله عليك أخي أبو أحمد كود أكثر من رائع كما عودتنا دائما بارك الله فيك وجزاك الله كل خير شكرا جزيلا
الردود الموصى بها
انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد
يجب ان تكون عضوا لدينا لتتمكن من التعليق
انشئ حساب جديد
سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .
سجل حساب جديدتسجيل دخول
هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.
سجل دخولك الان