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

الناس اللي بتطلب التثبيت مفيش استجابة لمطالبها ليه يا إخوة يا مشرفين؟

تفضل أخي الحبيب أبو آية Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Set UnionRange1 = Union(Range("E5:U5,E8:U8,E11:U11,E14:U14,E17:U17,E20:U20,E23:U23,E26:U26,E29:U29"), _ Range("E32:U32,E35:U35,E38:U38,E41:U41,E44:U44,E47:U47,E50:U50"), _ Range("E53:U53,E56:U56,E59:U59,E62:U62,E65:U65,E68:U68,E71:U71"), _ Range("E74:U74,E77:U77,E80:U80,E83:U83,E86:U86,E89:U89,E92:U92"), _ Range("E95:U95,E98:U98,E101:U101,E104:U104,E107:U107,E110:U110,E113:U113"), _ Range("E116:U116,E119:U119,E122:U122,E125:U125,E128:U128,E131:U131,E134:U134"), _ Range("E137:U137,E140:U140,E143:U143,E146:U146,E149:U149,E152:U152")) If Not Intersect(Target, UnionRange1) Is Nothing Then If Target.Value >= "40" And Target.Value < "50" Then Cancel = True Target.Value = "50" Else Cancel = False End If End If Set UnionRange2 = Union(Range("J3:U3,J6:U6,J9:U9,J12:U12,J15:U15,J18:U18,J21:U21,J24:U24,J27:U27"), _ Range("J30:K30,J33:K33,J36:K36,J39:K39,J42:K42,J45:K45,J48:K48"), _ Range("J51:K51,J54:K54,J57:K57,J60:K60,J63:K63,J66:K66,J69:K69"), _ Range("J72:K72,J75:K75,J78:K78,J81:K81,J84:K84,J87:K87,J90:K90"), _ Range("J93:K93,J96:K96,J99:K99,J102:K102,J105:K105,J108:K108,J111:K111"), _ Range("J114:K114,J117:K117,J120:K120,J123:K123,J126:K126,J129:K129,J132:K132"), _ Range("J135:K135,J138:K138,J141:K141,J144:K144,J147:K147,J150:K150")) If Not Intersect(Target, UnionRange2) Is Nothing Then If Target.Value >= "20" And Target.Value < "25" Then Cancel = True Target.Value = "25" Else Cancel = False End If End If End Sub

بارك الله فيك أخي عبد العظيم وجزيت خيرا على هذا العمل الرائع

الأخ الحبيب طارق طلعت تفضل المرفق التالي بمعادلة يمكنك عمل المطلوب وبدون أية مشاكل قائمة بأسماء الشيكات.rar

الأخ عبد الله الأخ أبو ايمان بارك الله فيكما على مروركما الكريم وجزاكما الله كل خير

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

موضوع متميز .. مبدع كعادتك دائما يا مستر وائل

رووووووووووووووعة فوق الرووووووووووعة يا مستر وائل جزيت خيرا على هذا الملف الرائع

اضغط Alt +F11 سيفتح لك محرر الأكواد Private Sub Worksheet_Change(ByVal Target As Range) Dim DupCtr As Double LastRow = Cells(Rows.Count, Target.Column).End(xlUp).Row If Not Intersect(Target, Range("D8:M26")) Is Nothing Then DupCtr = Application.WorksheetFunction.CountIf(Range(Cells(8, Target.Column), Cells(LastRow, Target.Column)), Target.Text) If DupCtr > 1 Then MsgBox "لقد أدخلت اسم موجود من قبل" Application.EnableEvents = False Target.ClearContents Application.EnableEvents = True End If End If End Sub النطاق من D8:M26 المراد العمل من خلاله الرقم 8 في السطر التالي له رقم الصف

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

السهل الممتنع (وائل المصري ) صاحب كل حصري

مشكور أخي في الله وائل العبقري الصاعد على هذه المشاركة

أخي الغالي تفضل الملف التالي فيه جزء من الحل store_v2.rar

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

السلام عليكم ومع كل جديد أحب أن أقدم لأخواني معلومة خفيفة ظريفة .. بدون أكواد وبعيدا على VBA في الملف المرفق يمكنك معرفة إذا ما كانت الخلية تحتوي على معادلة أم لا ..... بدون أكواد فقط بعض النطاقات المسماة !! IsFormula Without VBA.rar

جرب الكود بالشكل التالي: Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Set UnionRange = Union(Range("E8:U8,E18:U18,E28:U28,E38:U38,E48:U48,E65:U65,E75:U75,E85:U85,E95:U95"), _ Range("E105:U105,E122:U122,E132:U132,E142:U142,E152:U152,E162:U162,E179:U179"), _ Range("E189:U189,E199:U199,E209:U209,E219:U219,E236:U236,E246:U246,E256:U256"), _ Range("E266:U266,E276:U276,E293:U293,E303:U303,E313:U313,E323:U323,E333:U333"), _ Range("E350:U350,E360:U360,E370:U370,E380:U380,E390:U390,E407:U407,E417:U417"), _ Range("E427:U427,E437:U437,E447:U447,E464:U464,E474:U474,E484:U484,E494:U494"), _ Range("E504:U504,E521:U521,E531:U531,E541:U541,E551:U551,E561:U561")) If Not Intersect(Target, UnionRange) Is Nothing Then If Target.Value >= "40" And Target.Value < "50" Then Cancel = True Target.Value = "50" Else Cancel = False End If End If End Sub

أخي الحبيب جرب الملف التالي وتأكد من النتائج .. هذا جزء من الحل لو كانت النتائج صحيحة نكمل إن شاء الله حساب تاريخ هجري.rar

مشكور على مرورك الكريم أخي الحبيب محمد لطفي وجزيت خيرا على تشجيعك الدائم

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

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

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

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

الأخ الفاضل أبو ليمونة إليك حل آخر بالأكواد عله يفي بالغرض Report.rar

تسلم أخي الغالي أبو عيد بارك الله فيك

بسم الله ما شاء الله تبارك الله بارك الله فيكما وزادكما الله علما ونفع بكما المسلمين في غاية السعادة حينما أرى مثل هذه الأعمال الأكثر من رائعة