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

السلام عليكم هذه دالة معرفة ان شاء الله تفي بالغرض Function Abu_A(Cl As Variant) Select Case Cl Case 0 To 0.5: Abu_A = 50 * 1.1 Case Is > 0.5: ww = (Cl - 0.5) / 0.5 - Int((Cl - 0.5) / 0.5) If ww > 0 Then ww = 1 Abu_A = (50 + (13 * Int((Cl - 0.5) / 0.5)) + (ww * 13)) * 1.1 Case Is = "": Abu_A = "" End Select End Function انسخ هذا الكود وضعه في موديول جديد ثم في ورقة العمل قم بادراج دالة جديدة في الخانة التي تريد من مربع الادراج اختر دالة معرفة ستجد هذا الاسم Abu_A او انسخ هذه المعادلة =Abu_A(G3) ستقوم هذه الدالة بعمل الحساب حسب ما قمت انت بايضاحه في المشاركة السابقة

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

شرح الفصل السادس - حلقات التكرار (الجزء الاول)

اخي الفاضل في الخلية G7 مثلا مكتوب 0.8 وهذا يعني 800 جرام اي ان المبلغ يجب ان يكون 25 ريال على 500 ريال و 3.9 ريال على 300 جرام الاكثر من 500 والمجموع 28.9 ريال ولكن في ملفك 69.3 ريال فكيف حسبت

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

السلام عليكم اخي الفاضل ارقام الوزن في خلايا العمود G هل هي بالجرام ام ماذ

السلام عليكم اخي الفاضل لم يظهر عندي هذا الخطاء

السلام عليكم بسبب اعتذارا الاستاذ ابوعبدالله عن شرح الفصل السادس بسبب الانشغالات اعانه الله وموافقته على ان اقوم بالشرح نيابة عنه ساقوم باذن الله باخذ مكانه في شرح هذا الجزء وسابداء بإذن الله من اليوم == للعلم هذا الجزء يمثل عصب الدورة

السلام عليكم اخي الفاضل بدل هذه الازرار كلها تم وضع زر للزيادة والنقصان واحد فقط (ضع الموشر على الخانة التي تريد ) ثم اضغط بالزيادة او النقصان ونفس الشيء بالنسبة للمسح BookNo.rar

السلام عليكم جرب المرفق Show ListBox.rar

بارك الله فيك استاذ بن عليه ايه الفارس الصامت ذو الحلول الناجعة سلمت استاذ احمد يعقوب (ابو ابراهيم) ما احوجنا لاتقان الصفيف

ماشاء الله حلول واكواد ممتازة من استاذ خبير ولا تكفي الكلمات لايفائه حقه بارك الله فيك استاذ عبدالله

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

اخي بخصوص طلب كتابة عدد الاشهر بالنص (Two Month) اخي حاولت ولكن للاسف لم اتوصل الى نتيجة

اخي الفاضل لارفاق اي ملف قم بضغطه ببرنامج وينرار ثم ارفقه

اخي الفاضل في الخلية D4 استبدل المعادلة السابقة بهذه =IF(AND(F4="";E4="");"";IF(F4="";0;F4)-IF(E4="";0;E4)) ثم اسحبها للاسفل

السلام عليكم اخي الفاضل بالله عليك 30000 حلقة تكرارية ولما يخلص 10002 حلقة اخرى وينشط الكود بالتغيير في اي خلية ضمن المدى B3:f30000 وما تبغيه يبنشر ==== اخي بعد اذنك وضح المطلوب من الكود وسنحاول عمله في حدث الصفحة فقط

السلام عليكم اضافة الى حل الاخ الفاضل طارق عملت هذا الكود ولكن يشترط ان تكون اسماء المواد غير متشابهة (وانا افترضتها تبداء من A ثم B حتى تنتهي ب M) فكان هذا الكود جربه يمكن ينفع Sub Abu_Ahmed() Dim c As Range For Each c In [E6:E18] Select Case c.Value Case "B", "C", "D", "E": For i = -3 To -1 c.Offset(0, i) = c.Offset(-1, i) Next Case "G", "H", "I": For i = -3 To -1 c.Offset(0, i) = c.Offset(-1, i) Next Case "K", "L", "M": For i = -3 To -1 c.Offset(0, i) = c.Offset(-1, i) Next End Select Next End Sub

وبماذا يتم مل هذه الفراغات

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

جرب هذا الكود سيتم نقل المعادلة الى خلية تحدد انت صفها بنفس العمود (في البداية ضع الموشر على الخلية التي بها المعادلة التي تريد نقلها ثم فعل الكود) Sub Abu_Ahmed_Copy() w = Selection.Column x = InputBox("إختر رقم الصف الذي تريد", "إختيار") Selection.Copy Cells(x, w) Application.CutCopyMode = False End Sub

جرب هذا bank.rar

وهذا رابط فيه شرح http://www.officena.net/ib/index.php?showtopic=38885

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

السلام عليكم جرب هذا ضعه في حدث الصفحة Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, [A2:A20]) Is Nothing Then Target.Offset(0, 1).Value = Empty End If End Sub