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

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

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

وعليكم السلام ارفق ملف ليساعدك الأخوة الكرام بالمنتدى ..

جرب التعديل التالي Sub Test() 'Author : YasserKhalil 'Release : 22 - 10 - 2016 '------------------------- Dim Ws As Worksheet Dim Lr As Long Dim tempLr As Long Dim i As Long Dim lastRow As Long Application.ScreenUpdating = False Set Ws = Sheets("salry") With Ws Lr = .Range("B" & Rows.Count).End(xlUp).Row tempLr = .Range("C" & Rows.Count).End(xlUp).Row For i = tempLr To 1 Step -1 If Len(.Cells(i, 3)) <> 0 Then If Not .Cells(i, 3).HasFormula Then lastRow = i Exit For End If End If Next i For i = lastRow To Lr If .Cells(i, 3).HasFormula Then lastRow = .Cells(i, 3).Row + 6: Exit For Next i .Rows(lastRow & ":" & Lr).EntireRow.Delete If Application.WorksheetFunction.Count(Sheets("data").Columns(1)) < 20 Then Lr = .Cells(Rows.Count, 1).End(xlUp).Row .Range("A" & Application.WorksheetFunction.Count(Sheets("data").Columns(1)) + 8 & ":A" & Lr).ClearContents End If End With Application.ScreenUpdating = True End Sub

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

لم أفهم مشاركتك أخي الكريم هل تود رسم زر أمر وربطه بالكود .. للتنفيذ من خلاله؟

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

الموضوع مشاركة أم طلب أخي أبو صهيب؟

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

وعليكم السلام أخي أبو حنين بارك الله فيك وجزيت خيراً ..حل جميل لي ملحوظة بسيطة : هل يعقل لتطبيق الحل أن يقوم المستخدم بعمل معادلات في الثلاث أوراق عمل (أي قمت بالاستعانة بثلاثة أعمدة مساعدة) ... كما سيقوم بوضع ثلاثة معادلات للتنسيق الشرطي في الورقة الواحدة أي 9 في ثلاث ورقات ؟؟ ما بالك لو كان عدد الأوراق أكثر من 10 أوراق عمل مثلاُ ؟ أنا لا أقلل من شأن عملك والعياذ بالله ، ولكن أحببت فقط توضيح الأمور .. ويبقى العمل الذي قدمته عمل جميل ومميز تقبل تحياتي

وعليكم السلام جرب التالي If Answer = vbYes Then With Ws Union(.Range("h5:l" & Lr_Ws), .Range("n5:p" & Lr_Ws), .Range("s5:s" & Lr_Ws), .Range("t5:aa" & Lr_Ws)).ClearContents End With Else: End If

وعليكم السلام جرب الكود التالي Sub Test() 'Author : YasserKhalil 'Release : 21 - 10 - 2016 '------------------------- Dim Ws As Worksheet Dim Lr As Long Dim tempLr As Long Dim i As Long Dim lastRow As Long Application.ScreenUpdating = False Set Ws = Sheets("salry") With Ws Lr = .Range("B" & Rows.Count).End(xlUp).Row tempLr = .Range("C" & Rows.Count).End(xlUp).Row For i = tempLr To 1 Step -1 If Len(.Cells(i, 3)) <> 0 Then If Not .Cells(i, 3).HasFormula Then lastRow = i Exit For End If End If Next i For i = lastRow To Lr If .Cells(i, 3).HasFormula Then lastRow = .Cells(i, 3).Row + 5: Exit For Next i .Rows(lastRow & ":" & Lr).EntireRow.Delete End With Application.ScreenUpdating = True End Sub

طالما ظهر الخطأ NOM فأعتقد أن النسخة فرنسية .. بالتالي الحلول المقدمة صحيحة وجب عليك فقط أن تقوم بتغيير اسم الدالة المستخدمة هذا الملف سيساعدك في ذلك .. Translation Of Functions Officena YasserKhalil.rar

بسم الله ما شاء الله أخي وحبيي أبو عبد الرحمن .. ملف رائع من شخص مميز ..

جرب الملف التالي رابط الملف من هنا

جرب الملف التالي رابط الملف من هنا

جرب التعديل في هذا الجزء If Answer = vbYes Then WS.Range("h5:l" & LR_WS, "n5:p" & LR_WS, "s5:s" & LR_WS, "t5:aa" & LR_WS).ClearContents Else: End If

وعليكم السلام بالمثال يتضح المقال ..ارفق ملف مع شكل النتائج المتوقعة

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

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

بسم الله ما شاء الله أخي العزيز الزباري بارك الله فيك وجزاك الله خيراً ..

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

عوداً حميداً أخي وحبيبي إبراهيم .. أين كنت يا رجل ؟ أما افتقدت إخوانك!! شوف الرابط ده فيه شرح لكود أخونا العربي http://yasserkhalilexcellover.blogspot.com.eg/2016/10/search-using-arrays.html

بارك الله فيك أخي الكريم أحمد حليم ومشكور على مرورك العطر ودعائك الطيب .. ولك بمثله إن شاء الله

إليك الملف المعدل بعد إضافة تعديلات بسيطة على الدالة المعرفة لتتمكن من تشغيل أي ملف صوتي في نفس مسار المصنف الحالي .. حيث ستكتب المعادلة بالشكل التالي : اسم الدالة المعرفة يليها قوس مفتوح ولها 3 بارامترات الأول الخلية المطلوب اختبار الشرط بها ، والثاني الشرط المطلوب والذي في حالة تحققه يتم تشغيل الملف الصوتي ، والثالث هو اسم الملف الصوتي المطلوب تشغيله في حالة تحقق الشرط لتجربة الملف قم بإدخال قيمة أكبر من 1000 في الخلايا A5 أو N7 >>>إذا أردت إيقاف الملف الصوتي قم بتغيير القيمة إلى قيمة أقل من 1000 Play Sounds In VBA Using UDF Hanafy Officena