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

يمكن عمل المطلوب بدون معادلات صفيف ..بمعادلة شبيهة جداً بمعادلة أخونا عبد الباري

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

يوجد أعمدة مخفية في ورقة العمل "Report" أظهرها وزيد عدد السنوات كما تحب .. وقف في الخلية التي بها السنوات وادخل على الـ Data Validation وعدل المدى بحيث يشمل السنوات الجديدة لم أفهم هذه الجزئية .. يا ريت توضحها بالصور لو أمكن حاول لو الطلب مختلف عن الموضوع أن تطرح موضوع جديد ... تقبل تحياتي

من المفترض أن تكون النتيجة "خارج النطاق" في الحالة التي ذكرتها أخي سليم ولكن المعادلة الموجودة تظهر أن رقم 5 في المدى

اكتب 36-52 وفي خانة البحث اكتب 5 ستجد النتيجة "في المدى" ..

يمكن استخدام الجملة Select Case .. سأرفق لك ملف حاول الاستفادة منه وتطبيق الشروط ومرفق صورة جزء من حلقات افتح الباب لشرح استخدامها Select Case Tutorial ListenData.rar

جرب الكود التالي Sub Duplicate_Values() Dim myRange As Range Dim myCell As Range Set myRange = Range("A24:A110") For Each myCell In myRange If WorksheetFunction.CountIf(myRange, myCell.Value) > 1 Then myCell.Resize(1, 9).Interior.ColorIndex = 3 End If Next myCell End Sub تقبل تحياتي أو جرب الكود التالي ..سيتم تلوين الخلية الأولى فقط في أول حدوث ثم بعد ذلك في حالة التكرار سيتلون النطاق إلى العمود I وكل تكرار بلون مختلف ليسهل عليك استخراج المكرر Sub Color_Duplicates() Dim r As Range, myColor, N As Long myColor = Array(4, 7, 12, 38, 39, 40, 46) Columns(1).Interior.ColorIndex = xlNone ReDim Preserve myColor(1 To UBound(myColor) + 1) With CreateObject("Scripting.Dictionary") .CompareMode = 1 For Each r In Range("A1", Range("A" & Rows.Count).End(xlUp)) If r.Value <> "" Then If Not .exists(r.Value) Then Set .Item(r.Value) = r Else If TypeOf .Item(r.Value) Is Range Then N = N + 1: If N > UBound(myColor) Then N = 1 Union(.Item(r.Value), r).Interior.ColorIndex = myColor(N) .Item(r.Value) = myColor(N) Else r.Resize(1, 9).Interior.ColorIndex = .Item(r.Value) End If End If End If Next End With End Sub

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

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

أخي الكريم عمر برجاء وضع عناوين مناسبة تعبر عن الموضوع .. وأهلاً بك في المنتدى يبدو أن الملف تالف .. بعد تحميل الملف والإطلاع عليه دخلت على محرر الأكواد Alt + F11 وحاولت أن أغير الخاصية المسئولة عن إظهار وإخفاء ورقة العمل Data فقابلتني رسالة خطأ .. هذا دليل على أن الملف ربما يكون تالف أو تم التلاعب به بشكل كبير

الحمد لله أن تم المطلوب على خير ... ومشكور على دعائك الطيب وفي انتظار تقديم جديدك فقد غبت كثيراً عنا تقبل تحياتي

ودا فيديو بيشرح الخطوات بسرعة عشان لو الصور مش واضحة ليك 2016-08-30_17-26-28.rar

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

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

أخي الكريم أبو فادي أعلم أني تأخرت عليك ولكن شغلتني بعض الأمور الخاصة إليك الشرح بالصور لكيفية التعامل مع التنسيق الشرطي والآن بعد أن اطلعت على الصور إليك المعادلات التي ستقوم بإدخالها إلى التنسيق الشرطي .. سأذكر لك المعادلة واللون المصاحب (مع إمكانية أن تغير الألوان حسب رغبتك) ملحوظة : إذا أدرجت المعادلة ووجد خطأ قم باستبدال الفاصلة العادية بفاصلة منقوطة والأفضل أن تغير الإعدادات الإقليمية بحيث تكون الفاصلة العادية هي الافتراضية .. حتى يمكنك نسخ ولصق المعادلات بسهولة من المشاركة (إذا لم تكن تعرف بالأمر أخبرني وسأشرح لك كيفية عمله إن شاء الله) المعادلات : المعادلة الأولى (اللون الأحمر لمن انتهت فترة الصلاحية له) =AND($H4<>"",IFERROR(DATEDIF(TODAY(),$H4,"d"),-1)=-1) المعادلة الثانية (اللون الأزرق) =AND(DATEDIF(TODAY(),$H4,"d")>20,DATEDIF(TODAY(),$H4,"d")<=30) المعادلة الثالثة (اللون الأخضر) =AND(DATEDIF(TODAY(),$H4,"d")>30,DATEDIF(TODAY(),$H4,"d")<=60) المعادلة الرابعة (اللون البنفسجي لأقل من 10 أيام) =AND(DATEDIF(TODAY(),$H4,"d")>=0,DATEDIF(TODAY(),$H4,"d")<=10) المعادلة الخامسة (اللون الأصفر) =AND(DATEDIF(TODAY(),$H4,"d")>10,DATEDIF(TODAY(),$H4,"d")<=20) كان من الممكن أن أرفق لك ملف ولكني أحب الطريق الصعب لأنه الأسهل في الوصول .... تقبل تحياتي

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

أخي الكريم ..مسار الملفات في نفس مسار المصنف الحالي الذي يحتوي الكود ... سيتم إنشاء مجلد باسم Output في نفس مسار المصنف الحالي .. وكذلك الحال بالنسبة لكود العلامة أبو تامر في نفس المسار في مجلد اسمه "الأقسام_1" وإذا كررت الكود سيتم إنشاء مجلد جديد باسم "الأقسام_2"

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

فكرة جميلة أخي الغالي أبو عيد والتنسيق الشرطي رائع في تنفيذ المطلوب ولكن لا أعتقد ان هذا هو المطلوب بالنسبة للأخ هاني .. وإن كانت الطريقة أعجبتني كثيراً وقد تفي بالغرض ولكنك قمت بتغييرات في الجدول وأزلت الدمج ..!! ممكن أعرف في ورقة المعطيات ما هو Work Plan Level>؟ من أين يأتي في الجدول الرئيسي؟

ربنا يبارك فيك يا فلاحجي وعوداً حميداً .. المنتدى نور بعودتك تقبل وافر تقديري واحترامي

أخي وحبيبي ومعلمي عمر الحسيني ملف رائع ومبدع كالعادة ... بعد مشاركتك الأخيرة قمت بالتعديل مرة أخرى على الكود لأسهل على الأخ السائل المسألة .. قمت بإضافة إنشاء المجلد Ouput إذا لم يكن موجوداً من قبل .. وقمت بحذف الجزء الخاص بتسمية ورقة العمل والذي أتعبني بشدة ... حيث أن هناك رموز خاصة ما أن بعض الأسماء يزيد عن 31 حرف مما يؤدي إلى حدوث مشاكل أحببت أن يكون الكود عام يمكن استخدامه بشكل عام .. لذا أضفت دالة تحذف الرموز الخاصة بالنسبة لتسمية المصنفات ...لابد منها حيث قد تحتوي النصوص الموجودة على رموز خاصة مثل / \ : ؟ * وهي محرمة أن يسمى الملفات بها .. وهذا ما حدث معك بالضبط قم بتجربة ملفك مرة أخرى ولاحظ عدد المصنفات التي تم استخراجها .. ستجدها 32 ملف بينما الكود الخاص بي سيتستخرج 33 ملف .. المصنف المفقود بالنسبة إليك هو A399 وهو بالشكل التالي QMS&HSE : Quality Management System & Health, Safety لاحظ النص وفيه العلامة : ، وطبعاً بسبب استخدام سطر تخطي الخطأ حدث خطأ وتخطى هذا المصنف ولم ينشأ له مصنف .... من ثم ومما سبق شرحه ... تعرف أن البرمجة لا تخص ملف بعينه والأفضل أن نتعامل بشكل عام مع المشكلة لا أن نتعامل مع المشكلة من زاوية واحدة كان من الممكن أن أعالج الكود الذي قدمته باستخدام الدالة Replace ونستبدل علامة : بـ "" لا شيء وتمر المشكلة بسلام ويتم إنشاء الملف بدون مشاكل وتنتهي قضية الموضوع .. ولكني أحب أن أتعامل مع المشكلة بشكل أعم وأشمل ، وأعتقد أنك تقوم بذلك بالفعل وهذا ما يعجبني فيك كثيراً أمر آخر وهو الاستعانة بورقة العمل في تنفيذ المهمة ..هذا أمر لا أستحبه كثيراً وإن فعلت أقوم بالتخلص من المخلفات أي أقوم بحذف الأعمدة التي تم استخدامها أعتذر عن الإطاله في المشاركة ولكن وجبت المناقشة للوصول لأفضل الحلول بالنسبة لورقة العمل التي يتم العمل عليها يتم تغييرها في سطر الكود التالي Const sSheet As String = "MySheet" 'Sheet Name أي قمت بتغيير النص MySheet إلى Sheet3 .. حسب الملف المرفق في المشاركة الأولى وأخيراً إليكم الكود بعد التعديل الأخير Sub Export_Workbooks_Using_Filter() Dim a, I As Long, Dic As Object Dim strDir As String Const colNo As Long = 2 'Column Number Const sSheet As String = "MySheet" 'Sheet Name strDir = ThisWorkbook.Path & "\Output\" Call SpeedUp If Dir(strDir, vbDirectory) = "" Then MkDir strDir Sheets.Add before:=Sheets(1) Set Dic = CreateObject("Scripting.Dictionary") Dic.CompareMOde = 1 With Sheets(sSheet).[A1].CurrentRegion .Columns(colNo).Value = Application.Trim(.Columns(colNo).Value) a = .Value .Parent.AutoFilterMode = False For I = 2 To UBound(a, 1) If Not Dic.exists(a(I, colNo)) And Not IsEmpty(a(I, colNo)) Then Dic(a(I, colNo)) = Empty .AutoFilter colNo, a(I, colNo) .Copy Sheets(1).Cells(1) Sheets(1).Copy With ActiveWorkbook With Sheets(1) .DisplayRightToLeft = False .Columns.AutoFit End With .SaveAs strDir & RemoveSpecial(CStr(a(I, colNo))) & ".xlsx" .Close End With Sheets(1).Cells.Clear .AutoFilter End If Next I End With Sheets(1).Delete Call SpeedDown MsgBox "Done...", 64 End Sub Function RemoveSpecial(sInput As String) As String Dim sSpecialChars As String Dim I As Long sSpecialChars = "\/:*?""<>|" For I = 1 To Len(sSpecialChars) sInput = VBA.Trim(Replace$(sInput, Mid$(sSpecialChars, I, 1), " ")) Next I RemoveSpecial = sInput End Function Function SpeedUp() With Application .Calculation = xlManual .ScreenUpdating = False .DisplayAlerts = False .EnableEvents = False End With End Function Function SpeedDown() With Application .Calculation = xlAutomatic .ScreenUpdating = True .DisplayAlerts = True .EnableEvents = True End With End Function تقبلوا تحياتي

ما زال الموضوع غامض .. اعذرني لقلة فهمي ما هو شكل النتيجة المتوقعة وأين تريد وضع النتائج المتوقعة؟ بالنسبة للمثال المذكور الخاص بأيمن .. أخبرت أن أجازاته يومي السبت والأحد .. إذاً الأيام : 2 و 3 - 9 و 10 - 16 و 17 - 23 و 24 - 30 و 31 أجازات ولذا كتبت ر أي راحة ... بالمناسبة ما هي بقية الاختصارات ماذا تعني؟؟ يرجع مرجوعنا لأيمن : لاحظت إنك كتبت ر في كل الأيام اللي فاتت ما عدا الأيام 23 و 24 ذكرت أنه أخذ يوم راحة بدلاً منه - هذه المعلومة من العمود AL وهنا شيء غريب في العمود.هل تكتب التاريخ بالكامل أم اليوم فقط لأنني لاحظت في الخلية AL14 التالي 30/6+23 كيف تفسر هذه النقطة؟ أعتقد أن نتيجة المعادلة وهي رقم 24 ستوضع في هذه الحالة في الخلية AJ14 >> أهذا صحيح ؟ لابد من التأكد من كافة جوانب القضية لنستطيع فهمها وماذا عن أيام العطلات الرسمية ؟؟ هل لها دور في الأمر ..حيث أنه عمل في يوم عطلة رسمية وهو يوم عمل ...كيف يحتسب في هذه الحالة ؟؟؟ وهذا مثال لأيمن ماذا عن أحمد حيث مكتوب في أول عمود SHIFT A الموضوع محتاج كونسلتو أطباء ..

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

وعليكم السلام أخي الحبيب الجموعي إليك الحل في صورة تقبل تحياتي

بارك الله فيك أخي الغالي أبو علي (راسبوتين سابقاً) وجزيت خيراً على مساهمتك الرائعة وتخمينك الممتاز في الحقيقة أنني لدي من الحلول والتخمينات ما يمكنني أن أطرح مشاركة إيجابية لكني أود أن يلتزم الأعضاء بشيء واحد ولذا ألح عليه دائماً في كل مشاركاتي ، وهو التوضيح أريد أن نرتقي في أسلوب تقديم المشكلة قبل حلها إذ أن أي مشكلة إذا عرفت بشكل جيد تم حلها بنسبة 90 % وبدون جدال في ذلك عموماً لعله خير وإن شاء الله نرتقي ... بالتعاون معاً أخي الكريم محمد بالنسبة لطلبك لا يمكن التعديل في المعادلة نفسها إنما يكون التعديل في الخلايا المرتبطة بالمعادلة ذكرت أنك قمت بعمل معادلة Concatenate والتي تجمع النصوص من الخلايا ولنفترض أن الخليتين A1 و B1 تم عمل دمج للنصوص بينهما وكانت المعادلة في C1 ... لو أردت التعديل في الخلية C1 فهذا مستحيل لأنها معادلة .. أما الحل في هذه الحالة أن تقوم بالتعديل في أحد الخليتين المرتبطتين بالمعادلة أي بالخلايا A1 و B1 ..أرجو أن تكون قد اتضحت الصورة تقبلوا تحياتي