نجوم المشاركات

السلام عليكم ورحمة الله وبركاته إخواني الكرام ... ارتأيت أن موضوع المصفوفات بات من الأهمية بمكان بحيث لا يجب أن ننساه لما له من أهمية كبيرة في التعامل مع الأكواد بسرعة كبيرة جداً وخصوصاً في حالة التعامل مع كم هائل من البيانات .. فقررت أن أشارككم بما تقع عليه يدي من أكواد فيما يخص المصفوفات لنتعلم ونرتقي سوياً .. سأتناول كود بسيط بالتفصيل لنعرف ما هية المصفوفات وكيفية التعامل معها بشكل جيد الكود عبارة عن عمل حلقة تكرارية لعناصر المصفوفة من أول عنصر لآخر عنصر .. وإظهار العناصر في رسالة أو وضعها في نطاق أو التعامل معها كما تريد نبدأ بالكود بالكامل ثم نتناوله بالتفصيل Sub LoopInArray() Dim myArray As Variant Dim X As Integer myArray = Array("Yasser", "Khalil", "Officena", "Forum") For X = LBound(myArray) To UBound(myArray) MsgBox (myArray(X)) Next X End Sub السطر الأول هو بداية الإجراء الفرعي ويبدأ بكلمة Sub كما تعودنا يليه اسم الإجراء الفرعي ويفضل تسميته باسم يعبر عن الهدف من الكود ...قمت بتسميته LoopInArray حيث أننا سنتعامل بالحلقات التكرارية داخل عناصر المصفوفة .. وطبعاً لكل شيء بدأته لازم تقفله ..وقفلة الـ Sub بتكون بكلمة End Sub في نهاية الكود بالطبع السطر الثاني الإعلان عن متغير myArray وهو متغير للمصفوفة التي سنتعامل معها وقمت بتسميتها باسم مناسب وليس أي اسم (أفضل دائماً أن تكون أسماء المتغيرات معبرة عن المتغير والهدف منه ونوعه ..) السطر الثالث هو إعلان عن متغير من النوع Integer ووظيفة هذا المتغير أنه بمثابة عداد ..إذ أن من يعرف الحلقات التكرارية يعرف أنه لعمل حلقة تكرارية يستلزم أن يكون هناك عداد لهذه الحلقة التكرارية .. وقيمة المتغير X ستتغير مع كل حلقة .. أقصد أنه في أول لفة ستكون قيمة المتغير تساوي رقم البداية (فإذا كان رقم البداية 1 فإن المتغير يساوي 1) وفي اللفة الثانية تزداد قيمة المتغير بمقدار 1 ليصبح على سبيل المثال 2 وفي اللفة الثالثة يساوي 3 وفي اللفة الرابعة ..كمل إنت !! انتهينا من الأسطر التقليدية (تسمية الإجراء والإعلان عن المتغيرات) ... نتوقف قليلاً لللتجربة !! ماذا سنجرب يا ترى ؟ هل هناك ما يستدعي منا أن نجربه ونحن ما زلنا في البداية ولم نكتب أسطر فعلية للكود .. نعم لابد أن نتعلم شيئاً جديداً ومفيداً عند التعامل مع الأكواد ...... تطبيق : انسخ الكود السابق في موديول جديد ثم ضع الماوس داخل الإجراء الفرعي .. ومن قائمة View في محرر الأكواد اختر الأمر Local Window إنها نافذة ستجعل منك محترفاً في فهم الأكواد (صدقوني ستذهلون منها بشكل كبير جداً) ..إنها بمثابة نافذة لك لتدرك كيف يتم تنفيذ أسطر الكود سطر سطر انتبهوا لهذه النافذة بشكل كبير ... كيف سيتم التعامل مع هذه النافذة المدهشة ؟ الأمر في غاية اليسر والسهولة والبساطة .. ستستخدم من لوحة المفاتيح F8 وهو يمكنك من متابعة الكود سطر بسطر .. كفانا كلام نظري وننتقل للتطبيق .. ضع الماوس داخل الإجراء الفرعي (الكود) ثم اضغط F8 مرة واحدة فقط .. وانظر للنافذة التي كانت فارغة منذ قليل لقد أصبحت ثرية .. نعم ثرية .. بضغطة واحدة ستتمكن الآن من تحليل المتغيرات .. لقد تم وضع سطر باللون الأصفر على أول سطر بالكود كما تم وضع المتغيرات في النافذة بهذا الشكل في الناحية اليسار من النافذة توجد أسماء المتغيرات التي تم الإعلان عنها وفي العمود الأوسط قيمة المتغير ..فقيمة المتغير الأول Empty ما زالت المصفوفة فارغة لم يتم إضافة أي عنصر لها ، وقيمة المتغير الثاني لأنها من النوع Interger فتحمل القيمة صفر لأننا لم نضع قيمة لها بعد وفي العمود الثالث نوع المتغير فالمتغير الأول من النوع Variant وهذا النوع غالباً ما نستخدمه مع المصفوفة لأن المصفوفة مرنة ربما تحمل نصوص وربما أرقام وربما حتى نطاقات (موضوع يطول شرحه) إلى الخطوة الثانية والتي هي نفس الخطوة الأولى (حد يفكرني !!) محدش مركز !! ... الخطوة التانية اضغط F8 مرة تانية .. ماذا حدث ؟ لقد تجاوز السطر الأصفر أسطر الإعلان عن المتغيرات .. نعم لأنها أسطر غير قابلة للتنفيذ إنما تظهر المعلومات المرتبطة بهذه المتغيرات مع أول ضغطة على F8 بعد السطر الأول في الكود .. انتقل السطر الأصفر ليظلل السطر التالي .. ولم يحدث أي تغيير في نافذة الـ Local Window myArray = Array("Yasser", "Khalil", "Officena", "Forum") هل التنفيذ مرتبط بالسطر الأصفر ؟ نعم يتم تنفيذ السطر الملون بالأصفر بعد الخروج من السطر الأصفر وليس عند تظليل السطر الأصفر الخطوة الثالثة .. ماذا تتوقع أن يحدث بعد أن نضغط F8 للمرة الثالثة؟؟؟ فكر ثواني عشان تفهم اللعبة .. سيتم تنفيذ السطر الأصفر السطر الحالي عبارة عن تعيين قيم أو وضع عناصر للمصفوفة .. لدينا بعض الأسماء (وبما أن الأسماء نصوص فتم وضعها بين أقواس تنصيص) وهذه الأسماء سيتم وضعها داخل المتغير الذي قررنا أنه سيكون للمصفوفة انتبه انتبه ..لم أطلب منك أن تبدأ الخطوة الثالثة بعد ..!! فقط انظر لنافذة الـ Local Window على المتغير myArray وشوف القيمة هتلاقيها Empty أي أن المصفوفة فارغة (وكما بص على يسار اسم المتغير ..هل يوجد علامة زائد بجانب اسم المتغير myArray ؟؟ الإجابة لا يوجد) ابدأ تنفيذ الخطوة الثالثة ألا وهي نفس الخطوة الأولى ونفس الخطوة الثانية ..حد يفكرني !! محدش مركز .. اضغط F8 بردو (أنا مش عايز أتعبك أنا عايز تشوف وتتعلم وبعديها خلي دماغك يتكلم) ضغطت يا وائل ولا لسه على F8 ؟؟؟ تمام تمام الله ينور عليك ايه اللي حصل يا حوسو .. لما نحب نعرف ايه اللي حصل هنبص على الكود وعلى النافذة .. نبص الأول على الكود هنلاقي إنه تم الانتقال للسطر التالي وأصبح السطر التالي مظلل باللون الأصفر .. طيب الأهم إننا نبص على النافذة Local ونشوف المتغير myArray هنلاقي حاجة غريبة بتحصل .. حاجة بسيطة لكن مهمة المصفوفة اللي كانت فارغة Empty من شوية ومفيش علامة زائد جنبها .. أصبح فيه علامة زائد على يسار اسم المتغير ولما نبص في عمود القيمة هنلاقي كلمة Empty أصبحت مش موجودة .. دا لأنها بعد الانتقال من السطر اللي فات بقت المصفوفة فيها قيم .. نبص للعمود الثالث هنلاقي بردو فيه شيء اتغير ..نوع المتغير لم يتغير زي ما هو Variant بس فيه شيء إضافي .. هتلاقي ما بين قوسين بداية المصفوفة ونهاية المصفوفة بمعنى آخر المصفوفة اللي بنتعامل معاها دلوقتي فيها 4 قيم .. ولما نبص نلاقي الأرقام من 0 إلى 3 (افتراضي المصفوفة بتبدأ من الرقم 0 وليس الرقم 1 ) الأرقام دي عبارة عن فهرس للمصفوفة (زي فهرس كتاب) يعني مثلاً أول قيمة في المصفوفة اللي هي Yasser لها الرقم 0 في الفهرس .. والقيمة Khalil ليها رقم 1 وهكذا لنهاية القيم كل عنصر داخل المصفوفة ليها رقم في الفهرس .. عايز تتأكد من كلامي تعال على نفسك شوية ونتعب ونضغط علامة الزائد اللي على يسار اسم المتغير (خلي الصورة تتكلم شوية عشان أنا تعبت) زي ما إحنا شايفين الفهرس من 0 1 2 3 وكل عنصر له رقم في الفهرس وله قيمة يعني دلوقتي لو عايز أعرف تاني قيمة في المصفوفة هعمل ايه؟ ببساطة ممكن استخدم كلمة Msgbox ثم اسم المصفوفة ثم افتح قوس ثم أضع رقم القيمة المطلوبة ثم اقفل القوس MsgBox myArray(1) واحد يقولي إنت مش بتجيب تاني عنصر في المصفوفة ..طيب ليه كتبت واحد مش 2 (أقوله لأن المصفوفة بتبدأ من الصفر وليس من الواحد ..) فالواحد بمثابة 2 (عد من البداية ::: رقم صفر هو أول عنصر في المصفوفة .. رقم 1 هو ثاني عنصر في المصفوفة وهكذا) المهم عشان أنا بدأت أتوه من نفسي ننتقل للحلقة التكرارية ودي بيكون ليها عداد زي ما قلنا والعداد هنا X فبنقول For X وبعديها علامة يساوي ... بعد يساوي بداية الحلقة التكرارية يليها كلمة To ثم نهاية الحلقة التكرارية بداية الحلقة هتكون أول رقم فهرس في المصفوفة اللي هو في مثالنا يساوي صفر ، ونهاية الحلقة التكرارية هو آخر رقم في الفهرس اللي هو 3 وبدل ما نكتب من 0 إلى 3 (استخدمنا دالة بتجيب أول رقم في المصفوفة واسمها LBound ودي اختصار لكلمة Lower Bound أي الحد السفلي أي أول رقم في الفهرس ... وأيضاً بالمثل استخدمنا دالة عشان تجيب آخر رقم في المصفوفة والدالة هي UBound ودي اختصار لكلمة Upper Bound أي آخر رقم في الفهرس) طيب العداد لازمته ايه ؟؟ قلنا بيحمل القيمة الحالية ..فأول قيمة عندي هتكون صفر بالتالي قيمة X هتساوي صفر .. إحنا دلوقتي واقفين في السطر الملون باللون الأصفر مع بداية الحلقة التكرارية لو وقفنا بالماوس على كلمة X سيظهر تليح صغير في مستطيل أصفر صغير به قيمة المتغير ( في الصورة قيمة X تساوي صفر) وهو أول رقم في الحلقة التكرارية لأن رقم البداية صفر (والمتغير X يحمل قيمة أول رقم في بداية الحلقة) المهم اضغط F8 لتنتقل للسطر التالي وعايز تروح بالماوس وتقف على الكلمة دي myArray(X) هتلاقي مربع أصفر فيه القيمة Yasser وروح للـ X وقف عليها ستجد القيمة صفر أي أن المصفوفة المسماة myArray ثم نفتح قوس ونضع رقم الفهرس المطلوب ورقم الفهرس هنا هو صفر ..يحمل القيمة Yasser اضغط F8 لتظهر لك رسالة بقيمة أول عنصر في المصفوفة .. اضغط F8 مرة أخرى لتنتقل للفة الثانية في الحلقة .. ولاحظ أن الانتقال بعد ذلك سيكون ما بين السطرين MsgBox (myArray(X)) Next X القيمة X تتغير ويتغير معها القيمة التي تظهر في الرسالة .. أكمل الضغط على F8 لترى نتائج الكود بنفسك ... وعينك دائماً على نافذة Local لترى قيمة المتغير X وهي تتغير مع كل لفة وطبعاً عند وصول قيمة X لـ 3 تنتهي الحلقة التكرارية لأن نهاية الحلقة هو الرقم 3 أتمنى أن يكون الشرح واضح ومفيد للجميع مع تحياتي أخوكم ياسر خليل أبو البراء

أخي وحبيبي في الله أبو يوسف أعانكم الله على البلاء الذي ابتلاكم الله به .. ولا أملك لكم إلا الدعاء لكم أن يفرج الله عنكم ما ابتلاكم به .. وصبراً فمهما طال الليل لابد من بزوغ الفجر مساهمةً مني في الموضوع الرائع الذي بدأته ..سأساهم ولو بالقليل لعل أن يجد صدى ومنفعة لدى جميع الأعضاء أقدم لكم دالة من دوال الإكسيل وما يقابلها في محرر الأكواد الدالة هي CHAR : لمعرفة الحرف أو الرمز المقابل لرقم معين افتح ملف إكسيل وضع الرقم 1 في الخلية A1 وضع الرقم 2 في الخلية A2 ثم .. حدد الخليتين معاً وقم بسحب الخليتين من مقبض السحب .. واسحب الأرقام حتى الصف 255 أي اكتب الأرقام من 1 إلى 255 في الخلية B1 اكتب المعادلة التالية : =CHAR(A1) ثم قم بسجب المعادلة إلى آخر النطاق أي إلى الخلية B255 ستلاحظ وجود علامات ورموز وحروف في العمود الثاني ..هذا يدعى جدول الأسكي ASCII .. على سبيل المثال الأرقام من 0 إلى 9 تأخد الأرقام في جدول الأسكي من 48 إلى 57 الأرقام من 65 إلى 90 الحروف الإنجليزية الكبيرة الأرقام من 97 إلى 122 الحروف الإنجليزية الصغيرة الرقم 10 يمثل سطر جديد الرقم 32 يمثل المسافة (التي تؤخذ بالمسطرة يا باشمهندس) الرقم 44 يمثل الفاصلة , ------------------------------------------------------------------------ الدالة المقابلة للدالة CHAR في محرر الأكواد هي الدالة CHR مثال تطبيقي للاستفادة من الدالة : أنشيء ورقة عمل جديدة وضع النص التالي بهذا الشكل في الخلية A1 Yasser,Ahmed,Khalil,Salem,Baraa غير ارتفاع الصف وخليه 100 لتكون الأسماء واضحة أمامك الفاصلة تفصل بين الأسماء بفاصلة .. والمطلوب أن توضع الأسماء في نفس الخلية في أسطر متتالية أي تكون بهذا الشكل: قم بوضع الكود التالي في موديول .. Sub UseCHR() Dim str As String str = Range("A1").Value str = Replace(str, Chr(44), Chr(10)) Range("A1").Value = str End Sub يتم تعريف المتغير من النوع النصي باسم str ليحمل قيمة الخلية A1 وفي السطر الثالث يتم استبدال الفاصلة Chr(44) بسطر جديد Chr(10) ..بكل بساطة بالتالي أصبح لدينا المتغير الجديد تم فيه استبدال الفاصلة بسطر جديد .. في السطر الأخير يمكنك وضع قيمة المتغير في نفس الخلية A1 أو يمكنك وضعها في خلية جديدة كما ترغب أرجو أن تكون الخاطرة قد أعجبتكم تقبلوا وافر تقديري واحترامي

السلام عليكم ورحمة الله وبركاته اليوم أعرض علي حضراتكم كودى الجديد هذا الكود يساعدك على تحديد الخلايا التى تحتوى على حرف محدد و بناء عليه يمكن تنفيذ اجراءات أخرى على الخلايا المحددة كالنسخ أو الحذف أو .... أو .....الخ الكود وعليه الشرح : Option Explicit Sub SCCSCharacter() ' الكود التالى لتحديد الخلايا التى تحتوى حرف ' By Mokhtar 3/12/2015 ' المتغيرات Dim SelectRange, MyRng As Range, C As Range, MyString As String ' فى حالة حدوث خطأ تجاهله وانتقل للأمر التالى On Error Resume Next ' نطاق البحث Set MyRng = Sheet1.Range("C2", Range("C" & Rows.Count).End(xlUp)) ' النص الذى أبحث عنه MyString = Sheets("Sheet1").Range("C1").Text 'الغاء تحديث الشاشة Application.ScreenUpdating = False 'ازالة التنسيق عن نطاق البحث MyRng.Interior.Pattern = xlNone ' حلقة تكرارية على كل خلايا نطاق البحث For Each C In MyRng ' ' فحص اذا ما كانت الخلايا تحتوى النص الذى نبحث عنه أم لا If InStr(1, C.Value, MyString, vbTextCompare) > 0 Then ' If SelectRange Is Nothing Then ' شرط اذا لم يكن المتغير موجوداً Set SelectRange = C ' جواب الشرط : اعتبر أن المتغير يساوى قيمة الخلية Else 'اذا لم يتحقق الشرط Set SelectRange = Union(SelectRange, C) ' جواب الشرط : اعتبر أن المتغير يساوى اتحاد المتغير مع الخلية End If 'انهاء الشرط الاول End If ' انهاء الشرط الثانى Next ' الانتقال الى الخلية التالية If SelectRange Is Nothing Then ' اذا لم يكن المتغير موجودا MsgBox "الحرف :" & " " & "( " & MyString & " )" & " " & "لا يوجد فى الكلمات": Exit Sub ' رسالة للمستخدم بأن المتغير غير موجود بالنطاق وانهاء الاجراء Else ' اذا لم يتحقق الشرط ' CopyRange.Select SelectRange.Interior.ColorIndex = 38 ' قم بتلوين الخلية التى تحتوى المتغير باللون 38 End If ' انهاء الشرط Application.ScreenUpdating = True ' اعادة تفعيل تحديث الشاشة End Sub ' انهاء الاجراء المرفق لالالالالالالالالالالالالالالالالالالالالالالالالالالالالالالالا يوجد طبق الكود كالتالى : الخلية C1 أدخل فيها الحرف الذى تبحث عنه ( يمكن عمل قائمة منسدلة فيها بالحروف ) النطاق من C2 الى C10 أدخل به مثلا مجموعة كلمات وجرب الكود أرجو أن أكون قد قدمت لكم شيئا جديدا و مفيدا هذا من وجهة نظرى على الأقل و الرأى لحضراتكم - بعد تجربة الكود - فى النهاية والسلام عليكم ورحمة الله وبركاته

السّلام عليكم و رحمة الله و بركاته كمساهمة منّي في إثراء المواضيع المميّزة الرّائعة و الثّمينة من طرفك أستاذي القدير " محمد حسن المحمّد " و من طرف جميع الأساتذة الأفاضل المساهمين بهذا الموضوع فعاليّةً أو تشجيعًا طيّبًا جزاكم الله خيرًا و زادكم من علمه و فضله .. بهذا الملف المرفق في المشاركة أدناه .. قمت بكتابة اسم في الخليّة A1 .. ثم أشّرت بالماوس في بداية العمل على هذه الخليّة ذهبت الآن إلى التّبويب المشار إليه بالصّورة واختيار ما يشير إليه السّهم كذلك .. أرجو المعذرة سادتي الكرام لا أعرف التّرجمة الافتراضيّة الحقيقيّة لما يشير له السّهمان .. فقلت بنفسي الصّورة أكثر تعبيرًا من الكلمات : قمت بالتّأشير على الخانة المشار إليها بالسّهم ثم اتّبعتُ .. الآتي : قمت الاآن بالتّأشير على المربّع المشار إليه بالسّهم ..ثم أكملتُ الآتي : قمت باختيار الخلية التي ستكون بداية العمل .. مثلاً D1.. ثم الضغط على ..إنهاء .. و النّتيجة ..تجزئة الخلية A1 على عدة خلايا ..مثلما تشير له الصّورة فائق أحتراماتي تجزئة الكلمة .rar

اختار الشروط واضغط الزر ثم عدل في المواد ثم اضغط الزر وشاهد النتائج في اوراق الصفوف رصد درجات أعمال السنة فى الكنترول_Ali.rar

اللَّهُمَّ اكْفِنِي بِحَلَالِكَ عَنْ حَرَامِكَ، وَأَغْنِنِي بِفَضْلِكَ عَمَّنْ سِوَاكَ

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

جرب هذا الملف names_by_letters.zip

بسم الله الرحمن الرحيم .................... سلام الله عليكم ورحمته وبركاته ............. يسعدني أن أشارك أصحابي وأحبابي زوار وأعضاء ومشرفي ومديري أعرق منتدى لبرمجة الأوفيس منتدى أوفيسنا هذا الجهد المتواضع داعيا الله أن يتقبله ويجعله خالصا لوجهه الكريم ******* ولا تنسوني من صالح دعائكم حتى يقول لكالملك: آمين ولك مثلها ////////////////// ولا تجعل هذه الفائدة تقف عندك شاركها مع جميع أصحابك

السلام عليكم إخواني الكرام كل عام وأنتم بخير ... أقدم لكم دالة تقوم بالتحويل من التاريخ الهجري إلى الميلادي Function ConvertDate(ByRef StringIn As String) As String Dim SavedCal As Integer Dim d As Date Dim s As String SavedCal = Calendar Calendar = 1 d = CDate(StringIn) Calendar = 0 s = CStr(d) ConvertDate = Format(s, "dd/mm/yyyy") Calendar = SavedCal End Function لمزيد من التفاصيل يرجى زيارة الرابط التالي رابط الموضوع من هنا

السلام عليكم ورحمة الله وبركاته إخواني وأحبابي في الله أحببت أن أضع هذا الموضوع بين أيديكم ليكون مرجعاً لمن أراد معرفة بداية الطريق في التعامل مع محرر الأكواد والبرمجة الموضوع لن يطول فيه الكلام ، سأدع الصور تتحدث وتوصل المعلومة ، حتى تكون المعلومة أثبت للمتعلم حل مشكلة ظهور . رسالة تحذير الخصوصية عند حفظ المصنف كان معكم طائر البطريق من منتدى أوفيسنا العريق دمتم على طاعة الله Download VBE Basics

السلام عليكم ورحمة الله وبركاته بعد ان تصنع ملفك كاملا تستطيع مراحعه معادلاتك والدوال الموجوده فى ملفك جرب وقول رايك فى الكود الكود منقول للامانه العلمية Option Explicit Sub ListAllFormulas() Dim sh As Worksheet Dim cell As Range Dim nextrow As Long Application.ScreenUpdating = False With ActiveWorkbook On Error Resume Next Set sh = .Worksheets("Formula List") On Error GoTo 0 If sh Is Nothing Then .Worksheets.Add After:=.Worksheets(.Worksheets.Count) .ActiveSheet.Name = "Formula List" Else sh.Cells.ClearContents End If With .Worksheets("Formula List") .Range("A1:C1").Value = Array("Sheet", "Cell", "Formula") nextrow = 1 For Each sh In ActiveWorkbook.Worksheets If sh.Name <> "Formula List" Then For Each cell In sh.UsedRange If cell.HasFormula Then nextrow = nextrow + 1 .Cells(nextrow, "A").Value = sh.Name .Cells(nextrow, "B").Value = cell.Address .Cells(nextrow, "C").Value = "'" & cell.Formula End If Next cell End If If .Cells(nextrow, "A").Value = sh.Name Then nextrow = nextrow + 1 Next sh .Columns("A:C").AutoFit End With End With Application.ScreenUpdating = True end sub الكود يصنع ورقة باسم " Formula List بها المعادلات واسم الخلية والورقة الموجود بها المعادله

اخى الاكبر محمد حسن المحمد اشكر لك مرورك الكريم تعلمنا منك الكثير اسلوبك فى الردود مميز يكشف عن اخلاق وعلم وثقافة كبيرة وقيمة اخى الاكبر محمد حسن المحمد اشكر لك مرورك الكريم تعلمنا منك الكثير اسلوبك فى الردود مميز يكشف عن اخلاق وعلم وثقافة كبيرة وقيمة

ننتظر ابداع الاحبه

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

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

السّلام عليكم و رحمة الله و بركاته أستاذي الفاضل " سعد عابد " بارك الله فيك و جزاك الله خيرًا و زادك من علمه و فضله الدّال على الخير كفاعله .. سواء منقول أو مبتكر من لدنك ما أردت قوله سيّدي المحترم : مراجعة المعادلات و الدوال هل المقصود أنّ هذا الكود يراجع و يكشف لنا عن الخطأ إنْ وُجد !!؟؟ فائق إحتراماتي

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

بارك الله فيك على التّجاوب الطيّب أستاذي القدير ...

تقبل تحياتي العطرة أخي الحبيب عبد العزيز.

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

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

السلام عليكم ورحمة الله وبركاته إخوتي الكرام خاطرة استقيتها من دروس أستاذنا الجليل يحيى حسين كما أن للجديد لذته وجماله من البرمجيات فإن للقديم جاذبية خاصة يحن كل منا إلى ذكريات الإكسيل 2003 بقوائمه التي نظهرها بأساليب مختلفة منها منكشفة وعشوائية حيث نحن لها ونشتاق... قدم لنا الأستاذ يحيى مشكورا كودا يظهر هذه القوائم بأسلوب رائع كتب الكود ولم يكتب مكان الحدث أهو في حدث المصنف أو الورقة سأكتب لكم إياه بحدث الورقة لأنني جربته فكان ناجحا كما يلي:لايوجد زر كتابة الأكواد على الهاتف للأسف Private Sub Worksheet_SelectionChange(ByVal Target As Rang) Application.CommandBars("built-in menus").ShowPopup End Sub أرجو أن ينال إعجابكم والشكر الجزيل للأستاذ الكريم يحيى حسين الذي ذكرنا بنسائم الماضي الجميل والسلام عليكم.

السلام عليكم ورحمة الله وبركاته أخي الحبيب عبد العزيز شرف رفيع لي أن أرى مساهمات رائعة من إخوة كرام وأن يقرنوا اسمي بأسمائهم في مواضيع هامة كموضوع تجزئة الكلمات ضمن مجموعة من الخلايا. التسمية الافتراضية لما ذكرت بيانات - النص إلى أعمدة معالج تحويل النص إلى أعمدة -(الاختيار العلوي): محدد - السهم الآخر: التالي الخطوة الثانية:أشرت إلى (مسافة) الخطوة الثالثة: أشرت إلى عام ...تحديد الوجهة ثم إنهاء. فائق احترامي وشكري ومحبتي لكم جميعا

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

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

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

استخدم الدالة المعرفه التاليه Public Function f(N) Dim S As String S = Split(Replace(N, "/", ""), " ")(1) f = S End Function واستدعيها كالتالي =f(A1)

السّلام عليكم و رحمة الله و بركاته أخي الكريم و أستاذي القدير " محمّد حسن المحمّد " لا يمكنني سوى القول : إنّ مع العسر يسرَا الشّكر كل الشكر موصول لأستاذنا المحترم " ياسر خليل أبو البراء " على الدّعم الفعّال للموضوع و المساهمة المميّزة جزاكما الله خيرًا و زادكما من علمه و فضله فائق إحتراماتي لكما

على الموضوع على الشرح عليك ( باردة والله ) تحياتى

أخي الكريم ناصر المصري اطلع على الملف التالي عله يكون المطلوب إن شاء الله Grab Data With The Same Format Using Arrays.rar

السلام عليكم استاذي عبد العزيز جزاك الله خير الله ينوّر عليك ويعطيك العافية ويحفظ عيالك تحياتي

أخي الكريم أبو أحمد الحمد لله أنك توصلت لسبب المشكلة (بس متنساش إني توقعت وجود خلايا مدمجة من غير ما أشوف الملف ) بص بالنسبة للخلايا المدمجة الغيها لأنها لا تتوافق مع الأكواد ..حاول تضبط التنسيقات من غير ما تدمج الخلايا .. يعني مثلاً لو عندي نص طويل في الخلية A1 وليكن النص "الحمد لله الذي بنعمته تتم الصالحات" والخلية غير كافية .. ومش هينفع إني أوسع عرض العمود يبقا أول شيء بييجي في دماغك الدمج إنك تدمج الخلايا A1 و B1 و C1 و D1 عشان النص يظهر في الأربعة خلايا من A1:D1 أقولك اوعى تدمج .. وخليك مركز معايا ممكن تعمل ايه حدد الأربعة خلايا ... كليك يمين على الخلايا المحددة واختر الأمر تنسيق خلايا Format Cells >> ادخل على التبويب المسمى ALignment حلو الكلام ؟؟ قول حلو في أول قايمة منسدلة في النافذة اختر الأمر Center Across Selection واضغط أوك وبس خلاص ..سيتم المطلوب بدون دمج بالمناسبة يا ريت تغير اللقب اللي كله أرقام للقب الخاص بك بلاش 1427452 بتضايقني شوية تقبل تحياتي

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

السّلام عليكم و رحمة الله و بركاته أخي الكريم " مصطفى محمود مصطفى " غير الخصائص مثلما تشير الصّورة أدناه

السلام عليكم ورحمة الله تفضل يا اخي الملف اخفاء وظهور شيتات المصنف.rar

الكتالوج وقع مني ولا ايه لا حول ولا قوة الا بالله سيبك بقي من كل اللي فات انت محتاج كمثال ينقل البيانات من الشيت الاول الى الشيت التاني بتنسيقاته كلها تمام

اذا تقصد ترحيل من الصف الى ورقة رصد الدرجات جرب الكود التالي Sub Ali() Dim R1 As Range Dim R2 As Range Dim Wr As Worksheet Dim Mysh As Worksheet Dim Ary() As Variant Dim X, C, Ro Set Mysh = Sheets("رصد الدرجات") Set R1 = Mysh.[D1]: Set R2 = Mysh.[D3] For Each Wr In Worksheets With Wr If Trim(Split(.Name, " ")(1)) = R1 Then Lr = .Cells(.Rows.Count, 3).End(xlUp).Row For Rw = 5 To Lr If Val(Trim(.Cells(Rw, 4))) = Val(Trim(R2)) Then Ro = .Cells(Rw, 1).Row X = X + 1 ReDim Preserve Ary(1 To Lr, 1 To 9) For C = 1 To 9 Ary(X, C) = .Cells(Ro, C + 1) Next C End If Next Rw End If End With Next Wr Mysh.Range("B7").Resize(UBound(Ary, 1), UBound(Ary, 2)) = Ary() Erase Ary End Sub

" محمّد حسن المحمّد " بإذن الله .. نحن دومًا بانتظار جديدك سيّدي القدير المحترم

أخي الحبيب مختار بارك الله فيك وجزيت خيراً أخي السائل يمكنك معرفة التفاصيل من خلال الرابط التالي من هنا

بعد اذن أخى الغالى ياسر الملف ده جاهز Removing all spaces from text.rar Removing all spaces from text.rar

أخي الكريم أتذكر أني طلبت منك من قبل تغيير اسم الظهور للغة العربية إليك المعادلة التالية على اعتبار أن النص في الخلية A1 ضع المعادلة التالية في الخلية B1 مثلاً =SUBSTITUTE(A1," ","") تقبل تحياتي

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

السلام عليكم هكذا Sub Auto_Open() '' يتفعل عند الدخول للمصنف او عند تشغيل الكود Application.OnKey "%{F8}", "" End Sub لإعادة تفعيل الخاصيه كالتالي Sub Re_Ali() '' لإعادة تفعيل الخاصيه Application.OnKey "%{F8}" End Sub

أخي الكريم مفتاح أهلاً بك في المنتدى ونورت بين إخوانك يرجى تغيير اسم الظهور للغة العربية إليك الملف التالي فيه دالة معرفة تقوم بالمطوب إن شاء الله كما يوجد خاصية البحث في المنتدى وستجد موضوعات بهذا الخصوص كثيرة .. تقبل تحياتي Split Compound Names UDF Function.rar

Sub TransferToAllSheets() 'Author : YasserKhalil 'Released : 02 - Dec. - 2015 'Use : The Code Transfers Data In Column B To Its Proper Sheet In A ' If Value Found In The Target Sheet, It Won't Be Transferred. '------------------------------------------------------------------------- Dim Cel As Range Dim LR As Long With Application .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlCalculationManual End With For Each Cel In Sheets("Main").Range("A2:A" & Sheets("Main").Cells(Rows.Count, 1).End(xlUp).Row) If Evaluate("=ISREF('" & Cel.Value & "'!A1)") Then With Sheets("" & Cel.Value & "") LR = .Cells(Rows.Count, 1).End(xlUp).Row + 1 If Application.WorksheetFunction.CountIfs(.Range("A2:A" & LR), Cel.Offset(0, 1), .Range("C2:C" & LR), Cel.Offset(0, 3)) Then GoTo Skipper .Range("A" & LR).Resize(, 4).Value = Cel.Offset(0, 1).Resize(, 4).Value Cel.Offset(0, 10) = .Range("A" & .Cells(Rows.Count, 1).End(xlUp).Row) End With End If Skipper: Next Cel With Application .ScreenUpdating = True: .EnableEvents = True: .Calculation = xlCalculationAutomatic End With End Sub Sub ClearAllSheets() Dim WS As Worksheet For Each WS In ThisWorkbook.Sheets If WS.Name <> "Main" Then WS.Range("A2:D1000").ClearContents Next WS Sheets("Main").Range("K2:K1000").ClearContents End Sub أخي الكريم جرب التعديل بالشكل التالي عله يفي بالغرض إليك الملف المرفق فيه ما تطلب إن شاء الله Transfer Data To Proper Sheet Without Duplicates YasserKhalil V2.rar

فعلاً الكود لاينفذ شيء سأعمل عليه لاحقاً ان شاء الله

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