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

أخي الكريم أسامة أنا طورت الكود الأخير بحيث يلغي الدمج في العمودين ويضع القيمة كاملة في الخلية في العمود الثاني إليك الملف الأصلي لك الذي قمت بتحويل امتداده فقط إلى xlsm ووضعت الأكواد ، لكن لم أنفذ على الملف الأصلي الذي سأرفقه أية أكواد حتى لا يحدث أي خلل بالبياانات وسأترك لك التجربة ... حاول كما أخبرتك أن يكون العمل على نسخة احتياطية أنا عندما أكتب الكود أكتب الكود ولا أنفذه على الملف الأصلي ، بل أقوم بأخذ نسخة من الملف وأجرب عليها الكود للتأكد من صحة وسلامة النتائج ...حاول قدر الإمكان عدم الإخلال بالملف الأصلي قم بتحميل المرفق ثم اضغط Alt + F8 من لوحة المفاتيح واختر الإجراء الفرعي المسمى DetectMergedCells ونفذه .. وسترى الخلايا التي كانت مدمجة وتم إلغاء الدمج بها قم بالتعديل بعدها على الخلايا في العمود الثاني بما يتناسب مع مدخلاتك وبهذا تكون انتيهت من مشكلة الدمج في الخلايا في العمود الأول والثاني Merged Cells Osama Original.rar

أخي الكريم مهند الدالة ISREF ترجع القيمة True في حالة أن ورقة العمل موجودة وتعطي القيمة False إذا لم تكن موجودة والخلية A1 هي أول مرجع في ورقة العمل المراد التأكد من وجودها أو عدم وجودها مثال لتفهم عمل الدالة : قم بإنشاء مصنف جديد وتأكد من وجود ورقة العمل Sheet1 بها وجرب الكود التالي Sub CheckSheetExistence() MsgBox Evaluate("ISREF(Sheet1!A1)") MsgBox Evaluate("ISREF(Data!A1)") End Sub النتائج ستكون للسطر الأول True لأن الورقة موجودة والسطر الثاني False لأن ورقة العمل Data غير موجودة ... بالتالي لو رجعنا للكود الأصلي سنجد أننا استخدمنا كلمة Not لعكس النتيجة ..بمعنى أن السطر في الكود الأصلي يفحص ويتأكد من عدم وجودة ورقة العمل فإذا لم (لاحظ لم Not) موجودة يتم تنفيذ باقي الأسطر ..أو بمعنى آخر : لو الورقة مش موجودة هتكون نتيجة الدالة False ووضعنا Not قبلها فيتم تحويل القيمة من False إلى True ، بالتالي طالما أن القيمة ستكون True يتم تنفيذ الأسطر التالية ...

أخي الكريم أسامة أفهم مشكلتك بشكل واضح ولكن المشكلة الآن ليست في حذف الصفوف المكررة إنما في الملف نفسه كما أخبرتك وجدت ردك من 5 دقائق هذا يعني أنك متواجد الآن حاول تتابع معي حتى نحاول الوصول لحل لملفك لا أدري هل الحل الذي قدمه أخونا عمرو أسامة مرضي لك أم لا ... ؟ ولكن يجب التدقيق في المخرجات حتى لا تفقد أية بيانات مهمة وأنصحك بالعمل على نسخة احتياطية بشكل مبدئي حتى إذا اطمأن قلبك قمت بالتنفيذ على الملف الأصلي نبدأ بالدمج لأنه هو العائق في ملفك ..لاحظت أن الدمج يكون في بعض الأحيان في العمود الأول والثاني ولكن السؤال ... ماذا بعد إزالة الدمج ؟ أقصد ما هو شكل البيان المطلوب في العمود B .. مثلاً ..هناك في الخلية A33 خلية مدمجة وبها البيان IPD-COOR-8 ..هل تريد إزالة الدمج ووضع البيان بالكامل في الخلية B33 ...؟ وأفضل أن تقوم بإزالة الدمج بنفسك ...وإليك الملف التالي سيوضح لك مواطن الدمج في العمود الأول والثاني حتى ينتظم ملفك Merged Cells Osama.rar

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

أخي الكريم أبو هايدي ضع الأسطر التالية لتؤدي الغرض إن شاء الله Private Sub TextBox2_Change() If TextBox2 <> "" And TextBox3 <> "" Then TextBox4.Value = Val(TextBox2) / Val(TextBox3) Else TextBox4.Value = "" End Sub Private Sub TextBox3_Change() If TextBox2 <> "" And TextBox3 <> "" Then TextBox4.Value = Val(TextBox2) / Val(TextBox3) Else TextBox4.Value = "" End Sub

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

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

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

أخي الكريم أبو مرمر أفضل كلمة "جزاكم الله خيراً " أكثر من كلمات الشكر والثناء .. تقبل وافر تقديري واحترامي

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

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

أخي الفاضل أبو مرمر إليك هذا الفيديو بهذا الخصوص

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

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

أخي الكريم مهند كلمة "جزاكم الله خيراً" وقعها في نفسي وأجرها أفضل من كلمة الشكر .. إحنا من الآخر عايزين حسنات ودعوات (أفيضوا علينا بدعواتكم المباركة علها تكون لنا شفيعاً يوم البعث)

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

أخي الكريم أسامة استغرق ملفك مني حوالي الساعة للآن في محاولات لعمل المطلوب ..رغم أن المطلوب سهل لكن الملف معقد وهذا ما يجعل العمل صعباً بعض الشيء أولاً لابد من إزالة الخلايا المدمجة لنستطيع التعامل مع الملف بسلاسة ..الدمج عدو الأكواد .. قم بالضغط على Ctrl + F للبحث عن الخلايا المدمجة ، ومن النافذة التي ستظهر لك انقر الأمر Format ستظهر لك نافذة أخرى قم بالدخول على التبويب Alignment وضع علامة صح على Merged Cells ... ثم أوك ثم أخيراً انقر Find All ..سيستغرق الأمر حوالي دقيقتين تقريباً ..بعد ما ينتهي البحث اضغط Ctrl + A وأنت في صندوق نتائج البحث لتصبح الخلايا المدمجة محددة قم بتلوين الخلايا المحددة بلون مختلف عن الألوان الموجودة في الورقة لتمييزها ثم قم بمعالجة الخلايا المدمجة ..بعدها يمكن استكمال العمل على الملف سؤال مهم جداً : ما هي الأعمدة التي يجب البحث عن تطابق القيم بها في الصفوف ..ما الأعمدة التي تريد التعامل معها وإذا ما كانت القيم متشابهة في كل صفوف العمود الواحد منها يتم حذف الصفوف على أساسها؟ Watch.rar

بارك الله فيك على حسن استجابتك بتغيير اسم الظهور تقبل تحياتي

أخي الكريم محمد الخازمي ضع المعادلة التالية في الخلية D16 في ورقة ايصال =IF(ادخال!$J$13="دينار",ادخال!$I$13,"") وضع الكود التالي في حدث ورقة العمل الأولى "ادخال" ..كليك يمين على اسم ورقة العمل ثم View Code ثم الصق الكود التالي Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.CountLarge > 1 Then Exit Sub If Target.Address = "$K$13" Then If Target.Value = "بنك" Then Shapes("Check Box 8").OLEFormat.Object.Value = True Shapes("Check Box 10").OLEFormat.Object.Value = False Shapes("Check Box 12").OLEFormat.Object.Value = False ElseIf Target.Value = "بريد" Then Shapes("Check Box 8").OLEFormat.Object.Value = False Shapes("Check Box 10").OLEFormat.Object.Value = True Shapes("Check Box 12").OLEFormat.Object.Value = False ElseIf Target.Value = "بنفسة" Then Shapes("Check Box 8").OLEFormat.Object.Value = False Shapes("Check Box 10").OLEFormat.Object.Value = False Shapes("Check Box 12").OLEFormat.Object.Value = True End If End If End Sub تقبل تحياتي

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

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

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

أخي الكريم مهند الزيدي إليك شرح لأسطر الكود لعله يفيد الجميع ، والشرح مهدى لأخونا الحبيب الغالي محمد حسن بمناسبة رجوعه بعد غياب أيام Sub CreateSheets() 'تعريف المتغيرات Dim Cel As Range, strCel As String 'إلغاء خاصية تحديث الشاشة لتسريع عمل الكود Application.ScreenUpdating = False 'إزالة الحماية عن المصنف بكلمة السر المرفقة ThisWorkbook.Unprotect 123 'إزالة الحماية عن ورقة العمل التي تمثل النموذج المراد نسخه Sheet2.Unprotect 123 'حلقة تكرارية لكل الخلايا في النطاق المطلوب إنشاء أوراق عمل لكل خلية من خلاياه For Each Cel In Sheet1.Range("D4:R" & Sheet1.Cells(Rows.Count, 4).End(xlUp).Row) 'إزالة المسافات الزائدة من الخلية strCel = Trim(Cel.Value) 'إذا لم تكن الخلية فارغة يتم تنفيذ الأسطر التالية أما إذا كانت فارغة يتم الانتقال للخلية التالية If strCel <> "" Then 'شرط لاختبار وجود ورقة العمل من عدم وجودها ، فإذا لم تكن ورقة العمل موجودة من قبل يتم تنفيذ التالي If Not Evaluate("ISREF('" & strCel & "'!A1)") Then 'نسخ ورقة العمل النموذج في نهاية المصنف Sheet2.Copy After:=Sheets(Sheets.Count) 'تسمية ورقة العمل التي تم نسخها باسم الخلية التي عليها العمل في الحلقة ActiveSheet.Name = strCel 'إنشاء ارتباط تشعبي للخلية لربطها بالورقة التي تم إنشائها Cel.Hyperlinks.Add Cel, "", , "Screen_Tip", strCel Cel.Hyperlinks(1).SubAddress = "'" & strCel & "'" & "!A1" 'حماية ورقة العمل الجديدة التي تم نسخها ActiveSheet.Protect 123 End If End If Next Cel 'إرجاع الحماية للمصنف ThisWorkbook.Protect 123 'إرجاع الحماية لورقة العمل النموذج Sheet2.Protect 123 'إعادة تفعيل خاصية تحديث الشاشة Application.ScreenUpdating = True 'رسالة تفيد بانتهاء عمل الكود كنوع من التنبيه لا أكثر MsgBox "Done ...", 64 End Sub تقبل تحياتي

أخي الكريم ابن الملك المشكلة ليست في تعريف المتغيرات على ما أعتقد إنما تكمن المشكلة في بعض الدوال المستحدثة في الإصدارات الجديدة والتي لا توجد في الإصدارات القديمة وأنا شخصياً أفضل مواكبة التطور .. إحنا في 2016 ولسه الناس متعلقة بـ 2003 (بحجة إمكانيات الأجهزة ..) رغم إن النسخ الحديثة ممكن تشتغل على أجهزة إمكانياتها معقولة .. ممكن تحدد في المرفق الجزء اللي بتتكلم عليه .. وماذا تقصد تم تعريفها لأوفيس 2010 أو 2013 ؟؟ وما هي المشكلة التي تظهر عند استخدام 2007 مثلاً؟ تقبل تحياتي

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