hicham2610 قام بنشر أغسطس 8, 2020 مشاركة قام بنشر أغسطس 8, 2020 السلام عليكم من فضلكم في الملف المرفق 5 أوراق في الورقة g بها نتائج المتعلمين مجتمعة (الأقسام الأربعة) الورقة 1 نتائج القسم 1 فارغة الورقة 2 نتائج القسم 2 فارغة الورقة 3 نتائج القسم 3 فارغة الورقة 4 نتائج القسم 4 فارغة كيف يمكن برمجة زر الورقة g يحيث يتم ترحيل النتائج إلى كل ورقة (1و2و3و4)بعد التأكد من مطابقة العناصر التالية: رقم التلميذ والاسم وتاريخ الازدياد تفاديا للخطأ وجزاكم الله خيرا 6.xlsx رابط هذا التعليق شارك More sharing options...
أفضل إجابة سليم حاصبيا قام بنشر أغسطس 8, 2020 أفضل إجابة مشاركة قام بنشر أغسطس 8, 2020 جرب هذا الكود Option Explicit Sub My_Ad_filter() Dim Rg As Range Dim Cret_rg As Range Dim arr, itm Application.ScreenUpdating = False arr = Array(1, 2, 3, 4) Set Rg = Sheets("g").Range("A14").CurrentRegion For Each itm In arr With Sheets(itm & "") .Range("A14").CurrentRegion.ClearContents .Range("MM1") = "القسم" .Range("MM2") = itm Set Cret_rg = .Range("MM1:MM2") Rg.AdvancedFilter 2, Cret_rg, .Range("A14") Cret_rg.ClearContents End With Next Application.ScreenUpdating = True End Sub الملف مرفق H_2610.xlsm 3 2 رابط هذا التعليق شارك More sharing options...
hicham2610 قام بنشر أغسطس 8, 2020 الكاتب مشاركة قام بنشر أغسطس 8, 2020 السلام عليكم الأخ الكريم: سليم حاصبيا جزاك الله خيرا وأحسن إليك لكن هناك تغيير في جداول الأوراق 1-2-3 و4 ممكن الإبقاء على الأوراق كما هي في الملف الأصلي وإجراء المطلوب؟ جزاك الله خيرا وأحسن إليك رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر أغسطس 8, 2020 مشاركة قام بنشر أغسطس 8, 2020 تم التغيير في تصميم الأوراق لانها كانت تحتوى على خلايا مدمجة تعيق عمل الكود 2 1 رابط هذا التعليق شارك More sharing options...
seddiki_adz قام بنشر أغسطس 9, 2020 مشاركة قام بنشر أغسطس 9, 2020 مشكور على هدا العمل العظيم لكن عندي تساؤل لوكان الصفحات ليست ارقم بل هي اسماء : مكان 1 و 2 و 3 و 4 تكون مثلا محمد ، سمير ، سليم ، بن علي كيف نغير الكود؟ رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر أغسطس 9, 2020 مشاركة قام بنشر أغسطس 9, 2020 تستدبل قيم الــ Array بالأسماء (ما ليس رقماً داخل اقواس " " اما الأرقام بدون اقواس) هكذا مثلا arr = Array("سعيد", "أكرم", 3, 4, "Amine", "سليم") 2 رابط هذا التعليق شارك More sharing options...
seddiki_adz قام بنشر أغسطس 9, 2020 مشاركة قام بنشر أغسطس 9, 2020 (معدل) بارك الله فيك اخي بعد تطبيقة على الملف لاحظ يوجد خطا تم تعديل أغسطس 9, 2020 بواسطه seddiki_adz رابط هذا التعليق شارك More sharing options...
abouelhassan قام بنشر أغسطس 9, 2020 مشاركة قام بنشر أغسطس 9, 2020 شكر تقدير واحترام من اخيك رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر أغسطس 9, 2020 مشاركة قام بنشر أغسطس 9, 2020 اذا كانت العناصر في الـــ Array نصوصاً لا لزوم للأقواس في السطر حيث الخطأ (الأ صفر) (حتى وان وضعتها لا مشكلة) كما عليك وضع اسماء الصحفات الـــ Array وليس اي اسماء تخطر على بالك اما مكان الــ Itm في يقية اسطر الكود (بعد سطر الخطأ) تضع الشيء الذي تريد ان تفلتر على اساسه بين قوسين اذا كان نصاً 1 رابط هذا التعليق شارك More sharing options...
عبدالفتاح في بي اكسيل قام بنشر أغسطس 9, 2020 مشاركة قام بنشر أغسطس 9, 2020 اخي الكريم كود الاستاد سليم يعمل لو ركزت على الكود لعرفت الخلل اين في سطر المصفوفة اسماء الشيتات غير مفهومة اكتبها يدويا في سطر الكود لا بد انك قمت بنسخ ولصق وهذا يحدث في حالة اللغة العربية فقط 1 رابط هذا التعليق شارك More sharing options...
seddiki_adz قام بنشر أغسطس 9, 2020 مشاركة قام بنشر أغسطس 9, 2020 لاحظ احي المادة : عربية ، فرنسية، فيزياء ، علوم H_2610 -2.xls رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر أغسطس 9, 2020 مشاركة قام بنشر أغسطس 9, 2020 1- من ايت يأتي لك الاكسل بالورقة رياضيات وهي ليست موجودة ضمن الأوراق 2-يظهر انك تستعمل اصدار قديم من اكسل ليس فيه العامود MM 3- في هذه الحالة يمكن الاستعانة بأي عامود غير MM مثلاُ Z لاحظ الصورة فيصبح الكود بهذا الشكل Option Explicit Sub My_Ad_filter() Dim Rg As Range Dim Cret_rg As Range Dim arr, itm Application.ScreenUpdating = False arr = Array("عربية", "فيزياء", "فرنسية") Set Rg = Sheets("g").Range("A14").CurrentRegion For Each itm In arr With Sheets(itm) .Range("A14").CurrentRegion.ClearContents .Range("Z1") = "المادة" .Range("Z2") = itm Set Cret_rg = .Range("Z1:Z2") Rg.AdvancedFilter 2, Cret_rg, .Range("A14") Cret_rg.ClearContents End With Next Application.ScreenUpdating = True End Sub الملف مرفق H_2611 -2.xls 2 رابط هذا التعليق شارك More sharing options...
seddiki_adz قام بنشر أغسطس 9, 2020 مشاركة قام بنشر أغسطس 9, 2020 نعم استعمل 2007 شكرا جزيلا و بورك فيك جزاك الله خيرا 1 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.