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

غير الكود : Private Sub Worksheet_SelectionChange(ByVal Target As Range) [A1] = Date [A2] = Format(Date, "dd/mmm/yyyy") End Sub

السلام عليكم أعلم أن الموضوع ليس مكانه ، لكني بحاجة ماسة إلى هذا البرنامج أرجو مساعدتي لمن لديه البرنامج أن يفيدنا به http://www.officena.net/ib/index.php?showtopic=57746

طيب جرب تاخد المعادلة الموجودة في العمود F وتنسخها في العمود G ..هل هذا هو المطلوب أم أن هناك شرطاً للترقيم =IF(C2="","",SUBTOTAL(3,$C$2:C2))

أخي الحبيب تويوتا (سوق على مهلك سوق ..بكرة الدنيا تروق) أولا .. في الملف المرفق تم تسمية النطاق من A1 إلى آخر خلية بها بيانات ..أي أن النطاق غير ثابت (ديناميكي) ، تم تسمية النطاق MyNames =OFFSET(Sheet1!$A$1,0,0,COUNTA(Sheet1!$A:$A),1) تم استخدام الدالة Offset ، والدالة بها بارمترات : الاول بداية المرجع للنطاق و هو هنا A1 ، والثانيوالثالث خاص بعدد صفوف الإزاحة وعدد أعمدة الإزاحة وهنا القيمة 0 ، حيث أن العمل داخل النطاق ولن تتم عملية الإزاحة ، والرابع ارتفاع النطاق وهنا تم استخدام الدالة Counta لتقوم بعد كل الخلايا التي بها بيانات ، والخامس عرض النطاق وهو 1 لأنه في عمود واحد فقط .. وشرح الكود مرفق هنا Private Sub Worksheet_Change(ByVal Target As Range) 'تعريف المتغير Dim lReply As Long 'هذا السطر لتجنب وقوع خطأ ، إذا تم التعامل مع أكثر من خلية لا يتم تنفيذ الكود If Target.Cells.Count > 1 Then Exit Sub 'هنا التعامل مع هذه الخلية فقط والتي عنوانها D1 If Target.Address = "$D$1" Then 'إذا كانت الخلية الهدف فارغة لا يتم تنفيذ الكود ، ويتم الخروج من الإجراء الفرعي If IsEmpty(Target) Then Exit Sub 'في حالة إذا كان الاسم المدخل في الخلية الهدف جديد يتم تنفيذ التالي ، وهنا اعتمد على دالة العد لمعرفة وجود الاسم من عدمه If WorksheetFunction.CountIf(Range("MyNames"), Target) = 0 Then 'إذا كان الاسم غير موجود بالقائمة يتم ظهور رسالة تفيد بذلك ، وبها اختيار نعم أو لا lReply = MsgBox("Add " & Target & " to list", vbYesNo + vbQuestion) 'إذا كان الاختيار بنعم If lReply = vbYes Then 'يتم من خلال هذا السطر إضافة الاسم الجديد في آخر النطاق في العمود الأول Range("MyNames").Cells(Range("MyNames").Rows.Count + 1, 1) = Target End If End If End If End Sub

أنا عارف إنها عيب .. بس عيب متغطي بـ Cover أعتذر لكما إخواني إذا كنت قد أخطأت في حقكما وهاتوا راسكم أبوس عليها

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

السلام عليكم إخواني الكرام أريد برنامج لإدراج الرموز الرياضية باللغة العربية ، مش البرنامج اللي باللغة العربية ، أقصد يكون بيدعم التعامل مع اللغة العربية .. وجزاكم الله خير الجزاء

أخي الحبيب سليم ...أعتقد أن هذه المعادلة في التنسيق الشرطي تفي بالغرض =AND(B4<>B3,B4<B5)

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

بعد إذن أخي الحبيب وأستاذي الكبير الباشمهندس طارق محمود .. هذا تعديل بسيط (وليس لمثلي أن يعدل على مثلك) ولكن لضبط الكود قليلا فقط Bill Backup.rar

نورت الموضوع يا أ محمد عبد الصمد . ومتنساش طريق الألف ألف ألف ميل بيبدأ برسالة ترحيب تقبل تحياتي

العضو مخالف يا مشرفين (تاني مرة يكرر الحركة دي)

أخي الغالي سليم ..الحل موجود في المرفق (نشكرك على المساعدة) هذه هي المعادلة التي تؤدي الغرض =IF(OR(ROWS($A$1:A1)>$I$2,COLUMNS($A$1:A1)>$J$2),"",IF(MOD(COLUMN(),2)=1,(COLUMNS($A$1:B1)-1)/2,ROW(A1)))

أخي الغالي حسام إذا كان الأمر كما تقول فلا بأس .. إلا إن مثل هذه الكلمة لدينا في ثقافتنا تعتبر عيباً ... وبعدين إحنا ممكن غطيها ونقول ==== ..... ههههه أهي دي كمان خارجة (بس مش هتتأخر يدوب ساعة وترجع)

أخي الحبيب تفضل المرفق (رعم أني لم أفهم طلبك بشكل جيد) تفعيل معادلة sumproduct.rar

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

أخي الحبيب سليم ..أعتذر كنت مريض ولم أنتبه جيداً للكود الرائع الخاص بالأخ الغالي حسام .. أعتذر لكما عن عدم انتباهي لهذا الكود التحفة الروعة تقبلوا تحياتي ..

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

أستاذ سليم .. كود ايه ؟ فين كود حسام ده.. بدور عليه مش لاقيه ..هو حسام كتبه بالحبر السري

السلام عليكم إخواني الكرام بحمد الله تم الانتهاء من الحلقة الثانية عشر من حلقات افتح الباب ، وهات لي معاك كيلو كباب وهذا رابط الحلقة http://www.officena.net/ib/index.php?showtopic=57094#entry367291 أرجو أن أكون قد وفقت في الشرح .. مع الرجاء بالدعاء لي ولأسرتي

الحلقة الثانية عشر *************** السلام عليكم ورحمة الله وبركاته ... إخواني الكرام ..ها أنا قد عدت إليكم بعد طول عياب (والعود أحمد .. مش ياسر ولا حسام) نبدأ حلقة جديدة معكم من حلقات افتح الباب ، وهات لي معاك كيلو كباب (عشان لسه العشا مجهزش) نكمل في هذه الحلقة بإذن الله مشوار الدوال الخاصة بالتعامل مع النصوص - * - كنا اتكلمنا عن الدالة LCase الخاصة بتحويل أحرف اللغة الإنجليزية إلى حروف صغيرة ، والدالة UCase الخاصة بتحويل أحرف اللغة الإنجليزية إلى حروف كبيرة .. كلنا يعرف إن كتابة الأحرف باللغة الإنجليزية ليها تعامل خاص ..بمعنى آخر لو بنكتب اسم شخص ، مش مقبول إن يكون كل الحروف كبيرة ولا كل الحروف صغيرة ، إنما بيكون الحرف الأول في كل اسم حرف كبير والحروف المتبقية حروف صغيرة زي كدا Yasser Khalil طيب هل فيه دالة تكفي لهذا الغرض ؟ نعم .. روح لورقة العمل الأول واكتب اسمي (اسمي الأول جرب عليه وبعدين جرب على اسمك .. شايف حسام مش معبرني وبيكتب اسمه هو الأول !!) اكتب في الخلية A1 مثلاً yasser khalil كل الحروف Small أي حروف صغيرة ، وفي الخلية المجاورة B1 اكتب المعادلة التالية : =PROPER(A1) الناتج إن الحرف الأول في اسم Yasser والحرف الأول في اسم Khalil أصبحا كلاهما Capital - والحمد لله - نرجع لمحرر الأكواد .. ما هي الدالة البديلة لهذه الدالة في ورقة العمل ؟ هصدمك وأقولك مفيش .. وبعدين أفوقك من الصدمة وأقولك متقلقش فيه طريقة ..وطريقة ممتازة لاستخدام معظم الدوال وليس كلها في محرر الأكواد .. Sub ProperFunction() Dim strName As String strName = Range("A1").Value Range("B1").Value = Application.WorksheetFunction.Proper(strName) End Sub قمنا بالإعلان عن متغير نصي ، وقيمته هي قيمة الخلية A1 ، وفي السطر التالت .. عايزين قيمة الخلية B1 تساوي قيمة النص الموجود في A1 بس بشكل مختلف ، باستخدام الدالة Proper ، فنضع علامة يساوي (ومننساش اللي على الطرف الأيسر مجهول دائماً .. واللي على يمين علامة يساوي هو القيمة المراد وضعها للمجهول) استخدمنا هنا كلمة Application للإشارة إلى تطبيق الإكسيل .. ممكن الناس اللي مش أد كدا في الإنجليزي أقولها على خدعة بسيطة .. الخدعة إنك متحفظش الكلمة لو صعبة عليك ، اكتب بس أول كام حرف منها وليكن Appl واضغط Ctrl + مسطرة هتلاقي المحرر المحترم كمل لك الكلمة ، أو هتظهر لك قايمة تختار منها الكلمة اللي إنت عايزها .. بعد كلمة Application تم استخدام الخاصية WorksheetFunction وهذه الخاصية كأننا بنقول للمحرر إننا هنستعين بدوال الإكسيل المدمجة ، نستعين بها هنا في محرر الأكواد ، وبعديها نقطة وبعد النقطة وقفة (يعني قوم اقف واقعد تاني ..عشان تستعيد نشاطك) ، بعد النقطة هنكتب الدالة المراد الاستعانة بها ، وهي هنا الدالة Proper اللي فهمناها من شوية.. والدالة ليها بارامتر واحد بيتم استخدامه عن طريق فتح قوس (Shift + 9) ، وبين الأقواس بنكتب النص ، ومننساش إن الدالة بتتعامل مع النصوص !! ومننساش بردو قفلة القوس () ونكتفي بهذ القدر (فيه ناس رفعت ايديها وهللت خلصت الحلقة خلصت الحلقة ..متفرحوش أوي كدا ، إحنا لسه يدوب في بداية الحلقة .. انتهينا بس من الدالة Proper وكيفية استخدامها في محرر الأكواد) .. ****************************************************************************** ننتقل لدالة أخرى لذيذة جداً ومفيدة جداً ، ألا وهو الدالة Trim ودي دالة بسيطة جداً ، وظيفتها إزالة الفراغات الزائدة (بس خلاص .. انتهى الشرح) نروح لورقة العمل أولاً ونطبق الدالة ، اكتب في الخلية A3 مثلاً اسمي ، اضرب بالمسطرة 3 مرات لا خليهم 4 مرات ، واكتب Yasser وبعدين بالمسطرة اضرب 4 مرات وبعدين اكتب Khalil واضرب المسطرة 4 مرات (كفاية ضرب المسطرة اشتكت) .. في الخلية المجاورة B3 اكتب المعادلة بالشكل التالي : =TRIM(A3) هنلاقي الدالة قامت بالواجب وحذفت كل المسافات الزائدة ..وتركت مسافة واحدة بين الكلمتين فقط.. ننتقل لمحرر الأكواد .. نفس الاستخدام تقريباً ونفس الشكل : Sub TrimFunction() Dim strName As String strName = Range("A3").Value Range("B3").Value = Trim(strName) End Sub ننفذ الكود ، نلاقي الناتج في الخلية B3 يصدم (لم تؤدي الدالة عملها كما أدته في ورقة العمل) ، الدالة حذفت المسافات الزائدة في بداية النص وفي نهايته ، أما المسافات الزائدة بين الكلمتين فلم يتم حذفهم (مش عارف دا عيب في محرر الأكواد ، ولا بيل جيتس متعمدها ..عموماً هبقا أسأله في النقطة دي لما يطلبني في الاجتماع القادم يوم 30 فبراير القادم ) نفهم من كدا إن الدالة Trim في محرر الأكواد مختلفة عن الدالة Trim في ورقة العمل ..طيب ما الحل ؟ أشيروا علي إخواني الكرام ، الحل أبسط مما تتخيلوا (اللي فهم الدالة السابقة هيفهم إزاي هنحلها هنا ..) Sub TrimFunction() Dim strName As String strName = Range("A3").Value Range("B3").Value = Application.WorksheetFunction.Trim(strName) End Sub تم حل المشكلة بحمد الله وعونه وتوفيقه .. ****************************************************************************** ننتقل لدالة جديدة ، ألا وهي الدالة Space (المسطرة) ..وظيفة الدالة دي ، إننا نريح المسطرة من كتر الضرب عليها ، حيث أن شكوتها قد وصلت للأمم المتحدة ، فقررت الأمم المتحدة النظر في شكوى المسطرة الضعيفة التي اشتكت من كثرة الضاربين عليها ، وتوصلت الأمم المتحدة لاتفاق مع بيل جيتس بإدراج دالة تحل محل المسطرة في محرر الأكواد (وأغلقت القضية) .. في الخلية A1 اكتب Yasser Khalil وروح للمحرر واكتب الكود التالي : Sub SpaceFunction() Dim strName As String strName = Range("A1").Value Range("B1").Value = Space(4) & strName & Space(4) Range("C1").Value = Len(Range("A1")) & ":" & Len(Range("B1")) End Sub لاحظ إننا استخدمنا الدالة وبين قوسين كتبنا 4 ، والرقم دا عدد المسافات ، واستخدمنا الدالة مرتين ، مرة قبل النص ومرة بعد النص ، وفي كل مرة 4 مرات بالمسطرة ، يعني مجموع المسافات = 8 ، يعني إحنا ريحنا المسطرة من إننا نضربها 8 مرات ، وفي الخلية C1 استخدمنا الدالة Len (واللي ميعرفهاش يترك الحلقة دي ويرجع للحلقة اللي فاتت ..مش ناقصة وجع قلب ، وكتر كلام ع الفاضي) ، عشان نحسب طول النص في الخلية A1 وطول النص في الخلية B1 ، هنلاقي الفرق بينهم 8 (انتهى الحديث عن قضية المسطرة التي تشتكي). *************************************************************************** ننتقل إلى دالة ذات أهمية كبيرة ..الدالة Replace والكل يعرفها جيداً ، وربما الكل يستخدمها كثيراً ، وهي دالة الاستبدال (أي استبدال نص مش عاجبك بنص يعجبك ويدخل دماغك) تقوم الدالة باستبدال النص القديم بآخر جديد ... ناخد مثال يا أستاذ جمال : نفترض إني ادلعت شوية وأنا بكتب اسمي وكتبته في الخلية A1 بهذا الشكل Y a s s e r (من حق التلميذ يدلع ..مش الكبير لأ !!) .. المهم أنا من النوع الكسول ، أنا تركت مسافة بين كل حرف وحرف ، يا ترى هتعب نفسي وأشيل كل مسافة بين كل حرف وحرف (طبعاً مش هيحصل !! ولو حصل يبقا أنا مفيش ورايا شغل وقاعد بلعب) المهم دلوقتي نخلي بالنا ونسأل ايه هو اللي مش عاجبنا (الإجابة المسافة بين كل حرف وحرف) ، طيب ونسأل سؤال تاني (ما هو لازم تمشي بمنطق السؤال والإجابة) نسأل ايه المطلوب ؟ (الإجابة إننا نحذف المسافة أو ممكن نقول الطلب بشكل تاني عشان نقدر نوصل للحل :: المطلوب إننا نستبدل المسافة " " بـ "" (ايه ده ؟ هي دي الإجابة ؟؟ أقولك أيون أيون هي دي الإجابة) .. نشوف المثال يا أستاذ عبد العال .. الأول قبل المثال نشوف البديل ليها في ورقة العمل ، ضع المعادلة التالية في الخلية B1 : =SUBSTITUTE(A1," ","") الدالة تقوم باستبدال النص القديم بالنص الجديد (زي الفل ..نفس الكلام مع الدالة Replace في محرر الأكواد) Sub ReplaceFunction() Dim strName As String strName = Range("A1").Value Range("B1").Value = Replace(strName, " ", "") End Sub البارامتر الأول للدالة عبارة عن النص المراد البحث فيه المراد البحث داخله .. والبارامتر الثاني النص المراد استبداله أي النص القديم .. والبارامتر الثالث النص الجديد (اللي عاجبنا وبيحب أكل الجبنه) .. كدا انتهى الحديث عن الدالة Replace ..! *************************************************************************** الآن مع دالتين جديدتان (أعتذر قديمتان) الدالة Right والدالة Left .. كلنا نعرف استخدام هاتين الدالتين في ورقة العمل .. ناخد مثال في ورقة العمل أولاً لنفهم عمل الدالتين .. في الخلية A1 نكتب الإيميل yakh777@yahoo.com وفي الخلية B1 نكتب المعادلة بالشكل التالي : =RIGHT(A1,9) الناتج هو yahoo.com وهو العدد الذي حددناه في المعادلة .. وتم استخراج النص من ناحية اليمين (اللهم اجعلنا من أهل اليمين .. أنا والأعضاء في المنتدى أجمعين) في الخلية C1 اكتب المعادلة التالية : =LEFT(A1,7) فيكون الناتج النص من ناحية اليسار ، وهو yakh777 ,وحددنا عدد الأحرف 7 أحرف .. لو قمنا بتغيير الإيميل بأي إيميل آخر .. أكيد النتائج ستختلف .. إذاً لابد من حل لتكون المعادلة أكثر مرونة (الحل هو الاعتماد - يا أستاذ عماد - هنا على علامة @ ) .. دعونا نفكر بصوت عالي ..نفكر الأول ونشوف هنعمل ايه ؟؟؟ نبدأ بالدالة Right .. الأول في خلية نكتب المعادلة: =LEN(A1) هنلاقي عدد حروف النص 17 ... تمام !! قول تمام يا أستاذ هشام - ونكتب المعادلة التالية في خلية أخرى (أي خلية) =FIND("@",A1) ودي بنحدد من خلالها موقع علامة @ داخل النص .. هنلاقي الناتج 8 (أي أن موقع هذه العلامة رقم 8 . لو عدينا من الشمال هنلاقي رقمها 8) طيب نجرب نطرح طول النص بالكامل - موقع علامة @ هنلاقي الناتج 9 (تسعى في الخير يا كبير) هو دا المطلوب ... واحد رفع ايده وقالي : مش فاااااهم (هقوله مش هكرر تاني .. إنت خدها قاعدة لو مش هتقدر تفهمها .. لو حبيت تستخرج النص من جهة اليمين ، يبقى تحفظ الشكل ده : طول النص بالكامل - موقع العلامة @) يبقا ممكن نكتب المعادلة التالية في الخلية B1 : =RIGHT(A1,LEN(A1)-FIND("@",A1)) جرب تكتب أحرف زيادة على يمين العلامة أو على يسارها ، وشوف النتائج بنفسك !! (هنلاقي النتائج دايماً صحيحة سواء كتبت أحرف زيادة في اليمين أو في اليسار) .. طيب الدالة Left دي أسهل .. لأننا هنعتمد على موقع علامة @ وبس .. لو موقع علامة @ رقم 8 زي مثالنا ، يبقى المعادلة هتكون بهذا الشكل : =LEFT(A1,FIND("@",A1)) هنلاحظ الناتج فيه علامة @ للتخلص منها (هات أستيكة وامسحها) أو قم بطرح موقع العلامة @ - 1 ليصبح الناتج صحيح .. =LEFT(A1,FIND("@",A1)-1) نسينا شغل الأكواد ، واندمجنا في دوال الإكسيل . أعتذر ، لكن لابد من فهم المعادلة بشكل جيد ، حتى نتمكن من فهم العمل بالأكواد ... نروح للمحرر ::: Sub RightLeftFunction() Dim strEmail As String strEmail = Range("A1").Value Range("B1").Value = Right(strEmail, Len(strEmail) - InStr(strEmail, "@")) Range("C1").Value = Left(strEmail, InStr(strEmail, "@") - 1) End Sub أعتقد الموضوع أصبح واضح وضوح الشمس في نهار ملبد بالغيوم .. نفس الدالة اللي استخدمتها في ورقة العمل أخدتها نسخ ولصقتها في محرر الأكواد .. وبدلت شوية حاجات بسيطة : شلت المرجع A1 ووضعت مكانه المتغير strEmail ، وشلت Find ووضعت مكانها الدالة InStr (بس اللي مركز هياخد باله إن الدالة InStr بتبحث عن كومة القش وتشوف الإبرة -- لكن الدالة Find بتبحث عن الإبرة في كومة القش .. بمعنى آخر النص الفرعي المراد البحث عنه يختلف مكانه بالنسبة للدالة Find في ورقة العمل ، والدالة InStr في محرر الأكواد # انتهى الحديث عن الدالتين Right و Left ) ************************************************************************* ننتقل لآخر دالة (عشان أنا تعبت لكم صراحة ..) الدالة Mid ، وبردو فيه ناس تعرف الدالة كويس جداً من خلال ورقة العمل ... في الخلية A1 اكتب الإيميل yakh777@yahoo.com في محرر الأكواد اكتب الكود التالي : Sub MidFunction() Dim strEmail As String strEmail = Range("A1").Value Range("B1").Value = Mid(strEmail, 1, InStr(strEmail, "@") - 1) End Sub أنا بدأت بالمثال قبل الشرح .. الدالة ليها 3 بارمترات الأول هو النص المراد البحث داخله (كومة القش) ، والبارامتر الثاني هو بداية عملية التنقيب أو البحث وبيكون قيمة رقمية أكيد ، والبارامتر الثالث هو عدد الحروف المراد استخراجها .. في المثال النص هو المتغير strEmail وبداية عملية البحث 1 ، ولاستخراج عدد الحروف ولأنها غير معلومة أو أننا نريد استخراج الجزء الأول من النص قبل علامة @ قمنا باستخدام الدالة InStr لتحديد موقع علامة @ وطرحها من 1 لنحصل على عدد الأحرف على يسار العلامة (أظن مفهومة يا أخ سلومة).. واستخدامها في ورقة العمل مشابه تماماً لمحرر الأكواد .. المعادلة التي يمكن استخدامها في ورقة العمل : =MID(A1,1,FIND("@",A1)-1) الدالة ببساطة تقوم باستخراج النصوص التي ترغب ، ولكن استناداً إلى نصوص أخرى ... بهذا نكون قد انتهينا من دوال التعامل مع النصوص ... أرجو أن تكونوا قد وفقتم في فهم الحلقة على أكمل وجه .. الواجب المطلوب : في الخلية E5 قم بكتابة النص Yasser Khalil ، وفي الخلية المجاورة لها ، قم بعمل الكود اللازم لجعل النص يبدو بهذا الشكل Khalil, Yasser (لتسيهل الحل قم باستخدام دوال التعامل مع النص لاستخراج الاسم الأول ، والاسم الثاني ...مفتاح الحل) وإلى لقاء متجدد مع حلقات افتح الباب .. كان معكم أخوكم أبو البراء من مصمت أوفيسنا دمتم في رعاية الله

جرب الكود بالشكل التالي : With ActiveCell .FormulaR1C1 = "=IF(R[0]C15<>"""",R[0]C15+R[0]C16,"""")" .NumberFormat = "yyyy/mm/dd" End With

أولاً ارفق ملف أخي الغالي .. ثانيا هل يمكنك وضع الأكواد أو المعادلات في الأمر كود ليظهر بشكل ملائم أخي الحبيب هكذا <> هنا يتم وضع الكود أو المعادلة

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

أخي الحبيب ارفق ملف أولاً للإطلاع .. وأخبرنا ما نسخة الأوفيس التي تعمل عليها؟