جمعة ذكى قام بنشر يناير 30, 2016 قام بنشر يناير 30, 2016 ارجو معاينة الملف المرفق اريد نسخ بيانات تلاميذ من الصفحة الرئيسية الى صفحات متعددة بمجرد كتابة رقم الصف او الصفحة التوضيح بالملف المرفق وجزاكم الله خيرا مطلوب.rar
جمعة ذكى قام بنشر يناير 30, 2016 الكاتب قام بنشر يناير 30, 2016 شكرا استاذنا الكريم والكبير سليم حاصبيا جارى التجربة جزاك الله خيرا وجعله فى ميزان حسناتكم
مختار حسين محمود قام بنشر يناير 30, 2016 قام بنشر يناير 30, 2016 Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Application.ScreenUpdating = False Application.DisplayAlerts = False If Target.Column <> 3 Then Exit Sub Select Case Target.Value Case Is = 1 Target.EntireRow.Copy Sheets("الصف الاول").Range("A1000").End(xlUp).Offset(1, 0) Case Is = 2 Target.EntireRow.Copy Sheets("الصف الثانى").Range("A1000").End(xlUp).Offset(1, 0) Case Is = 3 Target.EntireRow.Copy Sheets("الصف الثالث").Range("A1000").End(xlUp).Offset(1, 0) Case Is = 4 Target.EntireRow.Copy Sheets("الصف الرابع").Range("A1000").End(xlUp).Offset(1, 0) Case Is = 5 Target.EntireRow.Copy Sheets("الصف الخامس").Range("A1000").End(xlUp).Offset(1, 0) End Select Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub بعد اذن الاستاذ سليم هذه الاضافة أخى الكريم ضع الكود التالى فى حدث الورقة بمجرد ادخال رقم الصف فى العمود c يتم الترحيل مباشرة 1
مختار حسين محمود قام بنشر يناير 30, 2016 قام بنشر يناير 30, 2016 عذرا نسيت انك مرقم التلاميذ فى كل الاوراق جرب ده عشان الترقيم Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Application.ScreenUpdating = False Application.DisplayAlerts = False If Target.Column <> 3 Then Exit Sub Select Case Target.Value Case Is = 1 Target.Offset(0, -1).Resize(, 7).Copy Sheets("الصف الاول").Range("B1000").End(xlUp).Offset(1, 0) Case Is = 2 Target.Offset(0, -1).Resize(, 7).Copy Sheets("الصف الثانى").Range("B1000").End(xlUp).Offset(1, 0) Case Is = 3 Target.Offset(0, -1).Resize(, 7).Copy Sheets("الصف الثالث").Range("B1000").End(xlUp).Offset(1, 0) Case Is = 4 Target.Offset(0, -1).Resize(, 7).Copy Sheets("الصف الرابع").Range("B1000").End(xlUp).Offset(1, 0) Target.EntireRow.Copy Sheets("الصف الرابع").Range("A1000").End(xlUp).Offset(1, 0) Case Is = 5 Target.Offset(0, -1).Resize(, 7).Copy Sheets("الصف الخامس").Range("B1000").End(xlUp).Offset(1, 0) End Select Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub 1
جمعة ذكى قام بنشر يناير 30, 2016 الكاتب قام بنشر يناير 30, 2016 في 30/1/2016 at 17:28, مختار حسين محمود said: Expand شكرا استاذنا الكريم والكبير مختار حسين محمود تم الامر بخير ولكن... اريد انه عندما يتم مسح او حذف الرقم يتم حذف البيانات من الصفحة التى تم بها النسخ وعند تغيير الرقم يتم تغيير مكان النسخ للورقة المناسبة جزاك الله خيرا وجعله فى ميزان حسناتكم
مختار حسين محمود قام بنشر يناير 30, 2016 قام بنشر يناير 30, 2016 حضرتك هتكمل بكود الأستاذ سليم و لا الكود الأخير 1
جمعة ذكى قام بنشر يناير 30, 2016 الكاتب قام بنشر يناير 30, 2016 استاذنا الكريم والكبير مختار حسين محمود انظر للمرفق بعد وضع الكود بتاع حضرتك ياريت لو نستطيع نسخ محتويات الخلايا فقط بدون تنسيق او بتنسيق ثابت للجميع ثم انه عند مسح رقم الصف من شيت data يتم مسح محتويات الخلايا المنسوخة فى باقى الشيتات لانى وجدت هذا فى احد برامج الكنترول المنفذة ببرنامج اكسل 2010 ولكنه محمى بالكامل بكلمة سر ولحضرتك جزيل الشكر والتقدير مطلوب 22.rar في 30/1/2016 at 18:09, مختار حسين محمود said: حضرتك هتكمل بكود الأستاذ سليم و لا الكود الأخير Expand حكمل بكود حضرتك الاخير مع وافر الشكر والتقدير لاستاذنا الكريم ومعلمنا العظيم سليم حاصبيا مع رجاء من سيادته بعم حرمننا من عظيم كرمه وغزير علمه لنتعلم ونستفيد ولكم الشكر والعرفان اساتذتى الاكارم
مختار حسين محمود قام بنشر يناير 30, 2016 قام بنشر يناير 30, 2016 Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) With Application .ScreenUpdating = False .DisplayAlerts = False End With If Target.Column <> 3 Then Exit Sub Select Case Target.Value Case Is = 1 Target.Offset(0, -1).Resize(, 7).Copy With Sheets("c1").Range("B1000").End(xlUp).Offset(1, 0) .PasteSpecial xlPasteValues .PasteSpecial xlPasteColumnWidths End With Case Is = 2 Target.Offset(0, -1).Resize(, 7).Copy With Sheets("c2").Range("B1000").End(xlUp).Offset(1, 0) .PasteSpecial xlPasteValues .PasteSpecial xlPasteColumnWidths End With Case Is = 3 Target.Offset(0, -1).Resize(, 7).Copy With Sheets("c3").Range("B1000").End(xlUp).Offset(1, 0) .PasteSpecial xlPasteValues .PasteSpecial xlPasteColumnWidths End With Case Is = 4 Target.Offset(0, -1).Resize(, 7).Copy With Sheets("c4").Range("B1000").End(xlUp).Offset(1, 0) .PasteSpecial xlPasteValues .PasteSpecial xlPasteColumnWidths End With Case Is = 5 Target.Offset(0, -1).Resize(, 7).Copy With Sheets("c5").Range("B1000").End(xlUp).Offset(1, 0) .PasteSpecial xlPasteValues .PasteSpecial xlPasteColumnWidths End With End Select With Application .CutCopyMode = False .ScreenUpdating = True .DisplayAlerts = True End With End Sub ده عشان الطلب الاول نسخ القيم وعرض الأعمدة فقط الطلب التانى عايز تمسح العمود C وكل البيانات فى كل الأوراق مش كده ولا تقصد حاجة تانى ؟
جمعة ذكى قام بنشر يناير 30, 2016 الكاتب قام بنشر يناير 30, 2016 الطلب التانى حضرتك عند حذف الارقام من العمود(c) فى الشيت data يتم مسح وازالة البيانات التى تم نسخها فى بقية الاوراق او عند تغيير الرقم تتم الازالة من الورقة التى كان بها النسخ السابق ويتحول للورقة الجديدة ولحضرتك جزيل الشكر
مختار حسين محمود قام بنشر يناير 30, 2016 قام بنشر يناير 30, 2016 حضرتك غيرت فى ورقة DATA أعمدة جديدة لذا ينبغى عليك أن تعديل فى الأوراق المرحل اليها لتتطابق تماما مع ورقة DATA تجنبا لحدوث أخطاء هذا ما لاحظته فى المرفق الاخير 1
جمعة ذكى قام بنشر يناير 30, 2016 الكاتب قام بنشر يناير 30, 2016 في 30/1/2016 at 18:45, مختار حسين محمود said: حضرتك غيرت فى ورقة DATA أعمدة جديدة لذا ينبغى عليك أن تعديل فى الأوراق المرحل اليها لتتطابق تماما مع ورقة DATA تجنبا لحدوث أخطاء هذا ما لاحظته فى المرفق الاخير Expand تم استاذى الفاضل والحمد لله وشاكر لمجهود سيادتك
مختار حسين محمود قام بنشر يناير 30, 2016 قام بنشر يناير 30, 2016 ضع الكود التالى فى مديول جديد الكود لمسح النطاق من الخلية a4 الى آخر خلية فى العمود j فى كل الاوراق و أؤكد مرة أخرى لابد من تتطاق جميع الأورارق Option Explicit Sub delallData() Dim ws As Worksheet On Error Resume Next Application.ScreenUpdating = False For Each ws In ThisWorkbook.Worksheets With ws .Activate .Range(Cells(4, "A"), Cells(Rows.Count, "J")).ClearContents End With Next ws On Error GoTo 0 Sheets("data").Activate Application.ScreenUpdating = True End Sub تحياتى 1
ياسر خليل أبو البراء قام بنشر يناير 30, 2016 قام بنشر يناير 30, 2016 أخي الحبيب مختار ليه السطر ده .. .Activate أطن فهمتني .. 1
مختار حسين محمود قام بنشر يناير 30, 2016 قام بنشر يناير 30, 2016 جرب ترحيل البيانات الى كل الأوراق و شيل السطر ده و جرب الكود
ياسر خليل أبو البراء قام بنشر يناير 30, 2016 قام بنشر يناير 30, 2016 في 30/1/2016 at 20:23, مختار حسين محمود said: جرب ترحيل البيانات الى كل الأوراق و شيل السطر ده و جرب الكود Expand هل تقصد أن السطر ضروري استخدامه ؟ لو كان ضروري فأكيد هناك طريقة تجعلك تستغنى عنه لا يحبذ استخدام Select و Activate في كتابة الكود إذ أنه يسبب بطء في التنفيذ 3
مختار حسين محمود قام بنشر يناير 30, 2016 قام بنشر يناير 30, 2016 في 30/1/2016 at 20:53, ياسر خليل أبو البراء said: لا يحبذ استخدام Select و Activate في كتابة الكود إذ أنه يسبب بطء في التنفيذ Expand أدرك ذلك ولكن بدون السطر ده الكود لن يعمل الا على الورقة الاولى فقط و السطر التالى له مع الحلقة التكرارية يستلزم بالضرورة تنشيط الأوراق ورقة ورقة لاتمام الحلقة التكرارية وهو فيه أكيد طرق أخرى لكن أخى معلم ابتدائى أخد منى النهردة كل تركيزى الله يبارك له 1
ياسر خليل أبو البراء قام بنشر يناير 30, 2016 قام بنشر يناير 30, 2016 جرب الكود بهذا الشكل (لم أختبر الكود) فقط قمت بإضافة نقطة قبل كلمة Cells للإشارة إلى ورقة العمل التي سيكون عليها الدور في الحلقة التكرارية دون تنشيط الورقة Sub DelAllData() Dim Ws As Worksheet Application.ScreenUpdating = False For Each Ws In ThisWorkbook.Worksheets With Ws .Range(.Cells(4, "A"), .Cells(Rows.Count, "J")).ClearContents End With Next Ws Sheets("Data").Activate Application.ScreenUpdating = True End Sub 2
مختار حسين محمود قام بنشر يناير 30, 2016 قام بنشر يناير 30, 2016 رااااااااااائع عندى حق أنا لما بقول إنك أستاذى ولا لأ ؟ 2
جمعة ذكى قام بنشر يناير 31, 2016 الكاتب قام بنشر يناير 31, 2016 قمة الروعة انا فى قمة المتعة فى مقعد المتفرج على العمالقة بصراحة متعتى بهذا السجال الجميع تفوق اى متعة قد اصل اليها جزاكم الله خيرا ونفعنا بكم وبعلمكم الغزير 1
ياسر خليل أبو البراء قام بنشر يناير 31, 2016 قام بنشر يناير 31, 2016 أخي الغالي مختار كل الحكاية إنك مش مركز ساعتها بس ..وبعدين أنا متعلم مثلي مثلك لا أستاذ ولا حتى مساعد أستاذ أخي الكريم المعلم الابتدائي جزيت خيراً بمثل ما دعوت لنا ، ووفقنا الله وإياكم هلا غيرت اسم الظهور ليعبر عن شخصكم الكريم ، فالمنتدى أسرة واحدة والجميع يعرف الجميع باسمه ولقبه تقبلوا تحياتي
جمعة ذكى قام بنشر يناير 31, 2016 الكاتب قام بنشر يناير 31, 2016 في 31/1/2016 at 05:59, ياسر خليل أبو البراء said: أخي الغالي مختار كل الحكاية إنك مش مركز ساعتها بس ..وبعدين أنا متعلم مثلي مثلك لا أستاذ ولا حتى مساعد أستاذ أخي الكريم المعلم الابتدائي جزيت خيراً بمثل ما دعوت لنا ، ووفقنا الله وإياكم هلا غيرت اسم الظهور ليعبر عن شخصكم الكريم ، فالمنتدى أسرة واحدة والجميع يعرف الجميع باسمه ولقبه تقبلوا تحياتي Expand أخوك جمعة ذكى على محافظة أسوان مدير مدرسة ابتدائى والعمر 46 سنة ولى عظيم الشرف ان اكون بين كوكبة من اروع العمالقة للتعلم منهم تحياتى للجميع ولكم جزيل التقدير والعرفان صفحتى على الفيس بوك https://www.facebook.com/gomaazaki
ياسر خليل أبو البراء قام بنشر يناير 31, 2016 قام بنشر يناير 31, 2016 تشرفنا بيك أستاذنا الفاضل ذكي جمعه وأهلاً بيك في أسرة أوفيسنا تقبل تحياتي
جمعة ذكى قام بنشر يناير 31, 2016 الكاتب قام بنشر يناير 31, 2016 في 31/1/2016 at 13:40, ياسر خليل أبو البراء said: تشرفنا بيك أستاذنا الفاضل ذكي جمعه وأهلاً بيك في أسرة أوفيسنا تقبل تحياتي Expand لكم تحياتى ايها الأفاضل جمعة ذكى ــ استاذنا ــ وليس ذكى جمعة هههههههههههههههههه ارجو من حضرتك الاطلاع على الملف المرفق أرسله لى احد الاصدقاء وفيه تنفيذ المطلوب بالدوال ترحيل.rar
ياسر خليل أبو البراء قام بنشر يناير 31, 2016 قام بنشر يناير 31, 2016 أعتذر إليك عن الخطأ الذي أوردته في اسمك ..أخي الفاضل جمعه ذكي بالنسبة للتعامل مع موضوع الترحيل وخلافه أفضل التعامل بالأكواد إذ أن المعادلات قد تحتوي على معادلات صفيف وهي مع كثرة البيانات تسبب ثقل في الملف وبطء في التعامل مع الملف بشكل ملحوظ تقبل وافر تحياتي 1
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.