إبراهيم ابوليله

اخى واستاذنا شوقى بالفعل كما قلت كلامك صحيح مائه فى المائه وان كان هناك الكثيرين فى هذا المنتدى يحاولون الاعتماد على انفسهم ولكن الفكره صائبه تقبل تحياتى

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

اخى ياسر كود جميل والاجمل انه بسيط تقبل تحياتى

اخى الكود يقف عند هذا السطر Set vbCom = Application.VBE.ActiveVBProject.VBComponents نرجو الافاده تقبل تحياتى

اخى شوقى قمت باخذ نسخه من الكود وارفقته فى محور الاكواد فى شيت جديد ولكن عند الدخول الى الورقه يحدث الخطأ الاتى ويقف عند السطر Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean ارجو الافاده

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

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

ياعمنا شوقى الله يهديك المرفق مش مرفق خالص ولا انت طمعت فيه ولا ايه الحكايه تقبل تحياتى

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

وأااااااااااو هو فيه كده ياجدعان

اخى شوقى اشكرك على التوضيح تقبل تحياتى

للرفع

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

اخى فهمت ما تقصده ان شاء الله يتم عمل المطلوب تقبل تحياتى

اخى تم عمل المطلوب على الرابط الاتى http://www.officena.net/ib/index.php?showtopic=57179&page=5

أخى ابا الياس هل تقصد هكذا تقبل تحياتى 2015..rar

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

اخى واستاذنا شوقى اخى ياسر اشكركم على متابعة الموضوع ولكنى كنت اريد ان اعرف هل ينفع استخدام الكود بالشكل الاتى If Not Intersect(Target, Range("a2" & lastColumn)) Is Nothing Then حيث ان الغرض من اضافه السطر الخاص بالحصول على اخر عمود lastColumn الى الكود هو عدم تحديد الخلايا فى الكود وان يكون عمل الكود حتى اخر عمود به بيانات والا فما الفرق بين السطر الاتى If Not Intersect(Target, Range("a2:g" & lastColumn)) Is Nothing Then والسطر التالى If Not Intersect(Target, Range("a2:g2")) Is Nothing Then تقبلو تحياتى

الاخوه الافاضل ارجو المساعده فى الخطا الذى يحدث تقبلو تحياتى ERR.rar

اخى واستاذنا شوقى بالفعل الملف يعمل جيدا تقبل حياتى

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

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

اخى ابو ايمان بناء على الطلب الخاص بك -------------------------------- أخي الأستاذ إبراهيم لك كل التحية على دالة التفقيط في الموضوع التالي http://www.officena....8839&hl=التفقيط وعندي ملاحظة عند كتابة 0.20 يكتب التفقيط فقط جنيه و20 قرش لاغير الصواب أن يكتب لنا فقط 20 قرش لاغير أتمنى ان تتقبل ملاحظتي --------------------------------------------------------------------------- تم التعديل تفقيط.rar

اخى ابن مصر اشكرك ولكنى اريد ذلك على الكود الذى قمت انا بارفاقه لان فى الكود يوجد معادله تقوم باستخراج بيانات وان عدد السطور التى تعمل المعادله عليها 7000 سطر لذلك تم استخدام المتغيرX وهو الوصول الى اخر سطر به بيانات تفاديا لطول الوقت فى تنفيذ الكود ولكن الخطأ الذى حدث هو عدم مسح اخر خليه لاحظ ان شكل الكود يكون كالاتى Private Sub Worksheet_Change(ByVal Target As Range) x = [f7000].End(xlUp).Row If Not Intersect(Target, Range("f4:f" & x)) Is Nothing Then Application.ScreenUpdating = False If Target.Value = Empty Then Target.Offset(0, 1) = "": Exit Sub ' [m4].FormulaR1C1 = _ "=IF(RC[-7]<>"""",IF(MAX(INDEX((R4C6:RC[-7]=RC[-7])*(R4C1:RC[-12]=RC[-12])*(R4C14:RC[1]),0))=0,"""",MAX(INDEX((R4C6:RC[-7]=RC[-7])*(R4C1:RC[-12]=RC[-12])*(R4C14:RC[1]),0))),"""")" '[m4].AutoFill Destination:=Range("m4:m" & x), Type:=xlFillDefault 'Range("m4:m" & x) = Range("m4:m" & x).Value 'For Each cl In Sheets("ÈíÇäÇÊ").[A2:A100] 'If cl = Target Then Target.Offset(0, 1) = cl.Offset(0, 1): Exit Sub 'Next Application.ScreenUpdating = True End If End Sub وبذلك اذا قمنا بتغير هذا السطر If Not Intersect(Target, Range("f4:f" & x)) Is Nothing Then الى If Not Intersect(Target, Range("f4:f7000")) Is Nothing Then ستجد ان عمليه المسح تتم بنجاح ولكن تطول فتره تنفيذ الكود فهل هناك فكره لتفادى هذا الخطأ مع الاستمرار فى استخدام تحديد النطاق من Range("f4:f" & x

الاخوه الافاضل ارجو المساعده فى الخطأ الذى يحدث كما هو موضح بالشيت error.rar