عبدالله المجرب

السلام عليكم اخي قنديل انت قمت بإستخدام دالة الاستاذ الحسامي ولكن كود الدالة غير موجود في الملف كما ان الدالة ترتب حتى العاشر فقط وللعلم فهي تقوم بجلب أسماء الطلاب للحصول على كود الدالة اليك الرابط (انصحك بمراجعة المرفق وطريقة عمله) http://www.officena.net/ib/index.php?showtopic=38931

ضع ملفك وضع ما تريد بداخله

فكرة رائعة وجميلة. بارك الله فيك

بارك الله فيك استاذ احمد على العمل المميز

السلام عليكم قمت تعديلات على الكود لتعديل صيغة التاريخ في الليست بوكس جرب المرفق 1 (2).rar

دائماً كما عهدناك مواضيعك مميزة واعمالك تُدرس بارك الله فيك استاذ عبدالله تقبل مروري

مرفقات مميزة تفتح بالفعل أفاق جديدة لفنون التعامل مع التنسيق الشرطي بصراحة اعجبني البحث بجزء من النص

السلام عليكم اليك هذا الرابط http://www.officena.net/ib/index.php?showtopic=39071

هل ممكن ترفق مثال لطلبك لان الفكرة ليست واضحة

السلام عليكم عمل رائع ارجو منك استاذ جمال شرح العمل وكيفية الاستفادة منه وشكراً

السلام عليكم جزاك الله خيرا وبارك فيك تقبل تحياتي وشكري

بارك الله فيك استاذ جمال == لي مداخلة على الدالة لتجاوز الخطاء اذا تم سحبها الى الاسفل اكسل 2007 =IFERROR(INDEX(names; MATCH(0; COUNTIF($B$1:B1; names); 0));"") أكسل 2003 =IF(ISERROR(INDEX(names; MATCH(0; COUNTIF($B$1:B1; names); 0)));"";INDEX(names; MATCH(0; COUNTIF($B$1:B1; names); 0))) ================ ملاحظة يجب الضغط على Ctrl +Shift +Enter للعلم فان names هو مدى الاسماء

السلام عليكم عمل مميز وتطويع رائع للمعادلات ===== عندي ملاحظة لو تم أدخال أسم أخر يبداء بنفس الحرف يختل الترتيب وتصبح هماك خلايا فاضية مثل لو تم أدخال اسم عبدالله المجرب عبد الله باقشير سيصبح هناك فجوة في الترتيب والله اعلم

السلام عليكم شاهد هذا الرابط ان شاء الله يفي بالغرض http://www.officena.net/ib/index.php?showtopic=40658&hl=

الف مبروك ويتربى في عزك أن شاء الله

عمل مميز من استاذ مميز

الحمد لله تمت الإجابة

السلام عليكم اخي سعد قمت بإختصار الكود ليكو كالتالي Sub BB() Range("c7:h100").ClearContents Set MySheet = Sheets("data") For i = 1 To 7 If i > 1 Then Range("C" & [d10000].End(xlUp).Row + 1) = "الأجمالي" Range("C" & [d10000].End(xlUp).Row + 2) = MySheet.Cells(7, i + 11) Range(MySheet.Cells(8, i + 11), MySheet.Cells(MySheet.Cells(Rows.Count, i + 11).End(xlUp).Row, i + 11)).Copy Range("d" & [d10000].End(xlUp).Row + 2 + T).PasteSpecial (xlPasteValuesAndNumberFormats) T = 1 Next For i = 7 To 60 Cells(i, "e") = Application.WorksheetFunction.SumIf(Sheets("saad").Range("c5:c10000"), Cells(i, "d"), Sheets("saad").Range("b5:b10000")) Cells(i, "f") = Application.WorksheetFunction.VLookup(Range("d8:d100"), Sheets("data").Range("c5:e100"), 3, 0) Cells(i, "g") = Cells(i, "e") * Cells(i, "f") Next Application.CutCopyMode = False With Sheets("report2").[b6:h60] .Font.NAME = "Arabic Typesetting" .Font.Size = 14 .Font.Bold = True .HorizontalAlignment = xlCenter ' End With End Sub

لا إله الا الله الحليم الكريم .. لا اله الا الله العلي العظيم .. لا إله الا الله رب السماوات السبع و رب العرش العظيم .. لا إله إلا الله وحده لا شريك له .. له الملك .. و له الحمد و هو على كل شيء قدير .. الحمد لله الذي لا إله إلا هو .. و هو للحمد أهل .. و هو على كل شيء قدير .. و سبحان الله .. و لا إله إلا الله .. و الله أكبر .. و لا حول و لا قوة إلا بالله .. إلهي .. أذهب البأس رب الناس ، اشف و أنت الشافي ، لا شفاء إلا شفاؤك ، شفاءً لا يغادر سقماً .. إلهي .. أذهب البأس رب الناس ، بيدك الشفاء ، لا كاشف له إلا أنت .. يارب العالمين آمين .. إلهي .. إني أسألك من عظيم لطفك وكرمك و سترك الجميل أن تشفيه و تمده بالصحة و العافية .. إلهي .. لا ملجأ و لا منجا منك إلا إليك .. إنك على كل شيء قدير

بصراحة عمل متقن واستخدام رائع لابداعات الاستاذ خبور (ابوعلي) كما احب انوه ان فورم البداية فكرة الاستاذ هشام السعيد (ابوعبدالله - اكسلجي) ====== وكل الشكر للاستاذ المبدع صاحي الغريب على ذكره لي في الموضوع ابو احمد

ما شاء الله عمل مميز ورائع

السلام عليكم في المرفق لو كان الشهر 4 سيتم اضافة قيمة المكافاءة في المجموع والا لن يحتسب المكافاءة شاهد المرفق وجرب تغيير وحفظ تاريخ الكومبيوتر للتجربة قبل فتح الملف مثال لصرف المكافئة1.rar

وبهذه الصسغة ممكن وضع زر الأمر في اي ورقة Sub Abu_Ahmed() Dim cl As Range Set Mysh = Sheets("2") Set Mysh1 = Sheets("1") For Each cl In Mysh1.Range("G2:G" & Mysh1.[G10000].End(xlUp).Row) If cl = Mysh.[G2] Then Mysh.Range("A2:F7").Copy Mysh1.Range("A" & cl.Row).PasteSpecial xlPasteValues Exit For End If Next Application.CutCopyMode = False Set Mysh = Nothing Set Mysh1 = Nothing End Sub

السلام عليكم اذاً استبدل الكود السابق بهذا Sub Abu_Ahmed() Dim cl As Range Set Mysh = Sheets("2") For Each cl In Range("G2:G" & [G10000].End(xlUp).Row) If cl = Mysh.[G2] Then Mysh.Range("A2:F7").Copy Range("A" & cl.Row).PasteSpecial xlPasteValues Exit For End If Next Application.CutCopyMode = False Set Mysh = Nothing End Sub ولكن ضع زر الأمر في الورقة 1

السلام عليكم هل ممكن توضيح لهذه الجزئية