وليد ابو عمر قام بنشر أكتوبر 15, 2015 قام بنشر أكتوبر 15, 2015 السلام عليكم... يوجد في المرفقات صفحة اكسل بها مجموعة ارقام.. واريد ان يتم تقسيم كل 3 ارقام في صفحة مستقلة.. حيث ان لدي العديد من الارقام ولن اقدر على تقسيمهم يدوي... وشكرا لكم ارقام.rar ويكون التقسيم في صفحة مستقلة وليس في ورقة تالية من الصفحة الاساسية
جمال عبد السميع قام بنشر أكتوبر 15, 2015 قام بنشر أكتوبر 15, 2015 بصراحة أخى الطلب غير واضح ياريت ترسل مرفق أخر به النتيجة المتوقعة من طلبك تقبل تحياتى
ياسر خليل أبو البراء قام بنشر أكتوبر 15, 2015 قام بنشر أكتوبر 15, 2015 أستاذي ومعلمي وأخي الحبيب جمال عوداً حميداً .. لقد افتقدناك كثيراً والله تقبل وافر حبي واحترامي
سليم حاصبيا قام بنشر أكتوبر 15, 2015 قام بنشر أكتوبر 15, 2015 (معدل) جرب هذا الكود (المرفق المرفوع ليس له علاقة بالأمر ولم استطيع حذفه) ولا ادري حتى كيف تم رفعه مع انه لمشاركة ثانية على هذا العنوان http://www.officena.net/ib/topic/64192-معاينة-محددة/#comment-417279 سؤال بسيط للادارة : كيف يمكن التراجع عن رفع ملف تم ادراجه الخطا؟ و عملية الحذف لا تستجيب Sub copy_every_3() Application.ScreenUpdating = False y = 0 x = Sheets.Count t = x If t > 1 Then On Error Resume Next For i = 2 To t Application.DisplayAlerts = False Sheets(i).Delete Next Else End If lr = Sheets(1).Cells(Rows.Count, 1).End(3).Row For k = 0 To lr Step 3 Sheets(1).Range("a" & k + 1 & ":a" & k + 3).Copy Sheets.Add After:=Sheets(Sheets.Count) ActiveSheet.Name = "list" & Chr(y + 65) ActiveSheet.Range("a1").PasteSpecial (xlValues) ActiveSheet.Columns(1).AutoFit y = y + 1 Next Sheets(1).Range("a1").Select Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub My_print_Set_Up.zip تم تعديل أكتوبر 15, 2015 بواسطه سليم حاصبيا
ياسر خليل أبو البراء قام بنشر أكتوبر 15, 2015 قام بنشر أكتوبر 15, 2015 أخي الحبيب سليم يرجى رفع الملف المرفق مرة أخرى يمكن تعديل المشاركة وحذف الملف الذي أرفقته من قبل ويكون الحذف من خلال النقر على كلمة حذف (أيقونة الحذف) ومسح السطر في المشاركة الذي يحتوي اسم الملف المرفق
سليم حاصبيا قام بنشر أكتوبر 15, 2015 قام بنشر أكتوبر 15, 2015 (معدل) اخي ياسر لقد حاولت حذفه كما اشرت لي و لكن لا فائدة مع العلم اني لم اقم برفع اي ملف في تلك المشاركة والله اعلم من اين جاء الملف المرفوع على كل حال هذا الملف الذي وضعته مع الكود كما يمكن الاطلاع على الملف لسابق لابداء الرأي حوله (اعتقد لا مانع من ذلك) every 3 cells in sheet.zip تم تعديل أكتوبر 15, 2015 بواسطه سليم حاصبيا 1
وليد ابو عمر قام بنشر أكتوبر 16, 2015 الكاتب قام بنشر أكتوبر 16, 2015 اشكر كل من قام بالرد على موضوعي ولو باي كلمة .. ولكن المطلوب حرفيا هو تقسيم كل 3 ارقام في صفحة مستقلة بالاكسل.. بحيث ان لدي مجموعة كثيرة من الارقام ويصعب علي تقسيم كل 3 ارقام فقط في صفحة... فهل هذا الطلب يصعب تنفيذه ايه الأخوة الكرام ارقام.rar
ياسر خليل أبو البراء قام بنشر أكتوبر 16, 2015 قام بنشر أكتوبر 16, 2015 أخي الكريم وليد أبو عمر هل اطلعت على مرفق الأخ الحبيب سليم؟ أعتقد أنه يؤدي الغرض .. إذا وجدت أية ملاحظات يرجى وضعها للمناقشة
وليد ابو عمر قام بنشر أكتوبر 16, 2015 الكاتب قام بنشر أكتوبر 16, 2015 أستاذي الجليل ياسر خليل أبو البراء لقد حملت الملف الذي وضعه الأخ سليم ولم اجد اي تعديل في الملف يمكنك تنزيله والاطلاع عليه
سليم حاصبيا قام بنشر أكتوبر 16, 2015 قام بنشر أكتوبر 16, 2015 (معدل) حاول استبدال الماكرو بهذا (لا توجد اخطاء) Sub copy_every_3() Application.ScreenUpdating = False y = 0 x = Sheets.Count Do While x > 1 Application.DisplayAlerts = False Sheets(x).Delete x = x - 1 Loop Application.DisplayAlerts = True lr = Sheets(1).Cells(Rows.Count, 1).End(3).Row For k = 0 To lr Step 3 Sheets(1).Range("a" & k + 1 & ":a" & k + 3).Copy Sheets.Add After:=Sheets(Sheets.Count) ActiveSheet.Name = "list" & Chr(y + 65) ActiveSheet.Range("a1").PasteSpecial (xlValues) ActiveSheet.Columns(1).AutoFit ActiveSheet.Range("a1").Select y = y + 1 Next Sheets("ورقة1").Activate Range("a1").Select Application.CutCopyMode = False Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub تم تعديل أكتوبر 16, 2015 بواسطه سليم حاصبيا 1
ياسر خليل أبو البراء قام بنشر أكتوبر 16, 2015 قام بنشر أكتوبر 16, 2015 أخي الحبيب سليم وضع الكود في حدث ورقة العمل يمكنك إدراج موديول جديد وقص الكود من حدث ورقة العمل إلى الموديول ثم إنشاء زر وربطه بالكود أو لو أحببت ارفقت لك الملف مرة أخرى به التعديلات المطلوبة 1
وليد ابو عمر قام بنشر أكتوبر 16, 2015 الكاتب قام بنشر أكتوبر 16, 2015 اشكركم من كل قلبي على هذا الجهد الكبير.. ولكنني لا اجيد التعامل مع الماكرو للاسف ويصعب علي عمل تلك المهمة .. فلو تكرمتم عمل ملف بهي المطلوب بحيث ارفق له باقي الارقام.. يكون لكم جزيل الشكر والامتنان.. ولو هذا العمل به مشقة عليكم... فجزاكم الله كل خير على ما فعلتموه من أجلي... شكرا لكم جميعا
سليم حاصبيا قام بنشر أكتوبر 17, 2015 قام بنشر أكتوبر 17, 2015 (معدل) تفضل اخي الملف جاهز وتحت لطلب و لمزيد من الخيارات ----- الملف الثاني every 3 cells in sheet salim.zip every 3 cells in sheet salim advanced.zip تم تعديل أكتوبر 17, 2015 بواسطه سليم حاصبيا
ياسر خليل أبو البراء قام بنشر أكتوبر 17, 2015 قام بنشر أكتوبر 17, 2015 أخي الحبيب سليم بارك الله فيك على هذه الهدايا القيمة بالنسبة للكود فهو رائع حقاً ولكن هناك نقطة في غاية الأهمية ألا وهي البيانات إذا كانت كثيرة جداً ربما يواجه المستخدم مشكلة لنفترض أن لديك 200 رقم وسيتم تقسيمهم كل 3 في ورقة عمل ..أي أنه سيلزم للأمر 66 ورقة .. في الكود اعتمدت على تسمية أوراق العمل باسم List ثم حرف من الحروف ، والحروف 26 حرف فقط بالتالي سيحدث خطأ .. أمر آخر : أفضل وضع الأكواد في موديول .. يمكن تعديل الكود بهذا الشكل Sub CopyEveryN() Dim LR As Long, Y As Long, N As Long, X As Long, K As Long LR = Sheets(1).Cells(Rows.Count, 1).End(3).Row Y = 0 N = [C1] If Not IsNumeric(N) Or N <= 0 Then MsgBox "اكتب عدداً صحيحاً", 64: Exit Sub If N >= LR Then N = 1 End If N = Int(N) X = Sheets.Count Application.ScreenUpdating = False Application.DisplayAlerts = False Do While X > 1 Sheets(X).Delete X = X - 1 Loop For K = 0 To LR Step N Sheets(1).Range("A" & K + 1 & ":A" & K + N).Copy Sheets.Add After:=Sheets(Sheets.Count) With ActiveSheet .Name = "List" & Y + 1 .Range("A1").PasteSpecial xlValues .Columns(1).AutoFit .Range("A1").Select End With Y = Y + 1 Next Application.Goto Sheet1.Range("A1") Application.CutCopyMode = False Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub أخي الحبيب سليم حاول تراعي الإعلان عن المتغيرات .. تقبل وافر تقديري و تحياتي
سليم حاصبيا قام بنشر أكتوبر 17, 2015 قام بنشر أكتوبر 17, 2015 (معدل) اخي ياسر مشكور جداً على هذا التعليق لاحطت ان هناك خطأ بسيط في الكود يتمثل في هذا اللسطر: المفروض انه في حالة تحطي عدد الصفوف ان تكون N=lr وليس N=1 يرجى الانتباه الى هذا الامر If N >= LR Then N = 1 every 3 cells in sheet salim advanced.zip تم تعديل أكتوبر 17, 2015 بواسطه سليم حاصبيا
سليم حاصبيا قام بنشر أكتوبر 17, 2015 قام بنشر أكتوبر 17, 2015 اخي ياسر اليك المزيد حول هذا الموضوع every n cells in sheet salim ++.zip 1
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.