ياسر خليل أبو البراء

الأخ الكريم وسيم الحمد لله الذي بنعمته تتم الصالحات يرجى تحديد أفضل إجابة من خلال الضغط على كلمة تحديد كأفضل إجابة في أسفل المشاركة التي أدت الغرض ؛ ليظهر الموضوع مجاب ومنتهي

أخي الكريم جرب الكود التالي .. يتم كتابة حروف الأعمدة في الخلية A3 كما هو مبين بالمرفق .. Sub ConvertToVlaues() Dim Col_array As Variant Dim I As Long Col_array = Range("A3").Value Col_array = Split(Col_array, ",") Application.ScreenUpdating = False Application.Calculation = xlCalculationManual For I = LBound(Col_array) To UBound(Col_array) With ActiveSheet.Columns(Col_array(I)) .Copy .PasteSpecial xlPasteValues End With Next I Range("A1").Select Application.CutCopyMode = False Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub تقبل تحياتي Pupils' Names.rar

أخي الكريم عرابي أهلاً ومرحباً بك في المنتدى يرجى ضغط الملف ثم رفعه ويرجى الإطلاع على التوجيهات في الموضوعات المثبته في المنتدى لمعرفة كيفية التعامل مع المنتدى .. تقبل تحياتي

أخي الكريم حاول توضح أكثر .. كدا الموضوع تاه عن الهدف وأصبح هناك طلب جديد إذا كان الطلب مختلف عن الطلب ها هنا يمكنك طرح موضوع جديد لتعم الاستفادة ..

الأخ الكريم أبو إلياس جرب الكود بهذا الشكل Sub Trheel() Dim CL As Range, I As Integer For I = 2 To 4 Sheets(I).Range("B2:H1000").ClearContents For Each CL In Range("H2:H" & [H10000].End(xlUp).Row) If CL.Value = Sheets(I).Name Then CL.Offset(0, -6).Resize(1, 7).Copy Sheets(I).Range("B" & Sheets(I).[B10000].End(xlUp).Row + 1) End If Next Next End Sub تقبل تحياتي

وعليكم السلام ورحمة الله وبركاته الحمد لله أن تم المطلوب على خير الأخ أحمد أبو زيزو اعذرني لعدم إطلاعي على ملفك .. يرجى طرح طلبك في موضوع مستقل ليستفيد الجميع وليساهم فيه الجميع إن شاء الله تقبلوا تحياتي

أخي لم تتضح الفكرة بالنسبة لي .. هل يمكنك وضع النتائج المتوقعة ؟ الأسماء التي تشير إليها هي أسماء مختلفة لأشخاص مختلفة أم لنفس الأشخاص .. هل تريد عدم تكرار نفس الاسم ؟ وماذا لو كان لنفس الاسم درجات مختلفة ؟؟؟!! أعتقد المطلوب غير واضح

يمكنك عمل ما تقول واستخدام الاختصارات مع الملف الذي أشرت إليه Personal جرب بنفسك بعض الأكواد التي لديك وقم بعمل اختصار لها وستجدها تعمل إن شاء الله

أبي وحبيبي أبو يوسف لو أحببت الأمر وأردتني البحث فيه والمحاولة فيه لفعلت إن شاء الله .. ولكن عليك أن توضح أكثر ما هو الشكل المتوقع ... أريد الدقة في توضيح الفكرة حتى يمكنني البحث والتقصي تقبل تحياتي وكل عام وأنت بخير

الأخ الكريم أهلا ومرحباً بك في المنتدى ونورت بين إخوانك يرجى مراجعة رابط التوجيهات من هنا لمعرفة كيفية التعامل مع المنتدى كما يرجى إرفاق ملف ليساعدك الأخوة الأعضاء ..أو يمكنك استخدام خاصية البحث في المنتدى فلربما تجد طلبك في موضوع آخر

الآن فهمت لم أدقق في الكود واعتمدت على العمود الأول في مسألة الخلايا الفارغة .. قم باستبدال هذا الجزء Range("A4:A28") بأي عمود آخر وليكن العمود B أي أن التغيير المطلوب بسيط للغاية جرب الكود Private Sub Worksheet_Change(ByVal Target As Range) Rem كود يقوم باظهار صف فارغ بعد ادخال بيانات في العمود السادس من الجدول المحدد If Target.Row > 3 And Target.Column = 6 Then Dim Cell As Range Application.ScreenUpdating = False Rows("4:28").EntireRow.Hidden = False For Each Cell In Range("b4:b28") If IsEmpty(Cell) Then Cell.EntireRow.Hidden = True Next Cell Range("A" & Cells(Rows.Count, 1).End(xlUp).Row + 1).EntireRow.Hidden = False 'هذا السطر مسئول عن تحديد الخلية المطلوبة بعد إظهار صف واحد Range("B" & Cells(Rows.Count, 1).End(xlUp).Row).Select Application.ScreenUpdating = True End If End Sub

الأخ الحبيب مختار بارك الله فيك وجزاك الله خير الجزاء طريقة جميلة ولكن يعيبها شيء واحد أنه عند إغلاق التطبيق ستجد نفسك مجبراً على إغلاق التطبيق مرتين متتاليتين .. ولما اللجوء إلى هذه الطريقة والإكسيل نفسه يوفر لك مجلد مخصص لذلك ألا وهو الملف المسمى PERSONAL الملف موجود في هذه المسار C:\Users\<username>\AppData\Roaming\Microsoft\Excel\XLSTART استبدل كلمة Username باسم المستخدم في الويندوز الخاص بك اذهب للمسار لتجد هذا الملف .. يمكنك فتح الملف والدخول لمحرر الأكواد لإضافة الأكواد التي تريدها .. إذا لم تجد الملف لا تنزعج يمكن ببساطة من خلال تطبيق الإكسيل تسجيل ماكرو جديد ومن خلال النافذة التي تظهر اختار من القائمة المنسدلة store maco in اختر Personal Macro Workbook وسيظهر معك الملف .. لا يعيب هذه الطريقة ما عاب الطريقة الأولى من إغلاق التطبيق مرتين .. إلا أنني لا أحبذ الاحتفاظ بالأكواد في هذه الملف لأنه يمكن أن يحدث خلل في نظام التشغيل فيضيع الملف بكل ما فيه .. أو يمكنك لتجنب ذلك أخذ نسخة من الملف كل فترة والاحتفاظ بها تجنباً لحدوث مشاكل في الويندوز فيمكنك وقتها استبدال الملف الذي قمت بالاحتفاظ به وإسترجاع أكوادك .. أرجو أن أكون وفقت في توصيل المطلوب

أخي الحبيب خالد الملف المرفق الأخير لا يوجد به كامل الشرح .. يرجى رفعه كاملاً لتمام الاستفادة وللاحتفاظ بهذه الكنوز ضمن المكتبة لدينا

أخي الكريم المنور أنور يوجد في كل مشاركة في الأسفل كلمة "تحديد كأفضل إجابة " راجع التوجيهات من هذا الرابط لمعرفة كيفية التعامل مع المنتدى تقبل الله منا ومنكم

أخي الكريم أنور يرجى تحديد أفضل إجابة ليظهر الموضوع مجاب ومنتهي تقبل تحياتي وكل عام وأنت بخير

جرب المعادلة التالية =IF(B5="x","منقطع عن الدراسة",IF(B5>=5,"ناجح","راسب")) طريقة اضافة خيار 3.rar

لم أفهم المطلوب بشكل كافي يرجى وضع الملف وبه معادلة الترقيم وتوضيح المطلوب بشكل أدق

الأخ الكريم حسن يرجى تغيير اسم الظهور للغة العربية .. راجع التوجيهات من هنا يوضع الكود التالي في حدث المصنف حيث يقوم بإخفاء الأزرار 2 و 3 و 4 ويتبقى الزر الأول فقط Private Sub Workbook_Open() With Sheet2 .Buttons("Button 2").Visible = False .Buttons("Button 3").Visible = False .Buttons("Button 4").Visible = False End With End Sub ثم قم بوضع الأكواد التالية في موديول .. لاحظ أنه في نهاية كل كود يتم إخفاء الزر الخاص بالكود وإظهار الزر التالي .. Sub ConvertToVlaues() Dim Rng As Range Set Rng = Union(Range("C:H"), Range("I:N")) Application.ScreenUpdating = False Rng.Copy Rng.PasteSpecial xlPasteValues Range("A1").Select With Sheet2 .Buttons("Button 1").Visible = False .Buttons("Button 2").Visible = True End With Application.CutCopyMode = False Application.ScreenUpdating = True End Sub Sub ButtonTwo() MsgBox "This is Button 2" With Sheet2 .Buttons("Button 2").Visible = False .Buttons("Button 3").Visible = True End With End Sub Sub ButtonThree() MsgBox "This is Button 3" With Sheet2 .Buttons("Button 3").Visible = False .Buttons("Button 4").Visible = True End With End Sub Sub ButtonFour() MsgBox "This is Button 4" With Sheet2 .Buttons("Button 4").Visible = False End With End Sub الإخفاء هو الوسيلة الوحيدة لعمل المطلوب حيث أن خاصية Enabled و Disabled لا تؤثر في عمل الكود بعد إصدار الأوفيس 2010 ... جرب الملف المرفق تقبل تحياتي Pupils' Names.rar

أخي الكريم أنس لا تنسى أن تحدد أفضل إجابة حتى يظهر الموضوع مجاب ومنتهي

أخي الكريم يرجى مزيد من التوضيح .. كيف هي شكل النتائج المتوقعة ؟ ....

أخي الكريم جرب هذا التعديل البسيط وشوف السطر وحاول تفهم أجزائه ولو استعصى عليك الأمر اسأل عن الجزء الغير مفهوم Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row > 3 And Target.Column = 6 Then Dim Cell As Range Application.ScreenUpdating = False Rows("4:28").EntireRow.Hidden = False For Each Cell In Range("A4:A28") If IsEmpty(Cell) Then Cell.EntireRow.Hidden = True Next Cell Range("A" & Cells(Rows.Count, 1).End(xlUp).Row + 1).EntireRow.Hidden = False 'هذا السطر مسئول عن تحديد الخلية المطلوبة بعد إظهار صف واحد Range("B" & Cells(Rows.Count, 1).End(xlUp).Row + 1).Select Application.ScreenUpdating = True End If End Sub

الأخ الكريم وسيم إليك المعادلة التالية علها تفي بالغرض =SUMPRODUCT(SUMIF(INDIRECT("'"&ROW(INDIRECT("1:15"))&"'!"&B$8&11),"<1E100")) أو هذه المعادلة =SUMPRODUCT(SUM(INDIRECT("'"&ROW(INDIRECT("1:15"))&"'!"&$B$8&11))) أو يمكنك استخدام معادلة الصفيف التالية لتحقيق الغرض ولكن لا تنسى هنا أن تضغط على Ctrl + Shift + Enter =SUM(N(INDIRECT("'"&ROW(INDIRECT("1:15"))&"'!"&$B$8&11))) إليك الملف المرفق فيه تطبيق المعادلة SUMIF & INDIRECT.rar

الأخ الغالي أبو حنين إليك هذا السطر يمكن إضافته في بدايات الكود بعد تعريف المتغيرات بحيث لو كانت الخلية فارغة يتم إظهار رسالة ثم الخروج من الإجراء If IsEmpty(Range("A1")) Then MsgBox "الخلية فارغة يرجى كتابة بيان بها", vbInformation: Exit Sub تقبل تحياتي

أخي الحبيب أبو يوسف صراحة لم أجري بحث بخصوص تلك النقطة ... لأنه في وجهة نظري حتى لو كان في الإمكان عمل ذلك ألن يكون الأمر مزعجاً ظهور رسالة ملتصقة بمؤشر الماوس ؟؟؟ أو لربما لم تصلني فكرتك بعد ..

أخي الكريم حسن يرجى تغيير اسم الظهور للغة العربية إليك الملف التالي عله يفي بالغرض .. يمكنك النظر داخل الكود وإضافة النطاقات المراد تحويلها لقيم Sub ConvertToVlaues() Dim Rng As Range Set Rng = Union(Range("C:H"), Range("I:N")) Application.ScreenUpdating = False Rng.Copy Rng.PasteSpecial xlPasteValues Range("A1").Select Application.CutCopyMode = False Application.ScreenUpdating = True End Sub وكل عام وأنت بخير :fff: Pupils' Names.rar