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

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

أخي الحبيب وائل صراحة أخشى أن أخطيء .. فالخطأ هنا لا محل له من الإعراب قمت بتعديلات بسيطة على الملف بحيث يكون أيسر للناظرين اطلع عليه وراجعه بشكل جيد حتى يكون مرجع للجميع وتكون نسخة موحدة .. وأفضل بعد عمليات المراجعة أن يتم حذف هذا الموضوع أو التنويه أن الموضوع مغلق وهناك موضوع أحدث منه وتوضع فيه النسخة النهائية بعد المراجعة الدقيقة لها جزاك الله خير الجزاء على كل لحظة قضيتها في حفظ كتاب الله تقبل وافر تقديري واحترامي UthmanicHafs1 V.9 14-4-2016.rar

أخي الكريم الطلب غير واضح لو كنت تريد النتائج بهذا الشكل لما لا تكتب أول رقم في الخلية A1 .. أي تكتب رقم 18 في الخلية A1 ثم في الخلية A2 ضع المعادلة التالية واسحبها =A1+2 إذا لم يكن المطلوب يرجى إرفاق ملف للتوضيح تقبل تحياتي

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

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

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

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

خير اللهم اجعله خير .. مجمع الملك فهد وافق على التعديل ... لعله خير إن شاء الله

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

جرب الكود بهذا الشكل بعد عمل حماية لورية العمل بكلمة السر 1 Private Sub Worksheet_change(ByVal Target As Range) Dim Cl As Variant, Dat As Variant Dim DupCtr As Double Dim LastRow As Long If Not Application.Intersect(Target, Columns("A:A")) Is Nothing Then Application.EnableEvents = False If Target.Cells.Count > 1 Then Dat = Target.Formula For Each Cl In Dat If Cl <> "" Then MsgBox "Change Only One Cell At A Time", , "Too Many Changes!" Application.Undo: Application.CutCopyMode = False GoTo Skipper End If Next Cl End If '========================================================================= End If Skipper: Application.EnableEvents = False ActiveSheet.Unprotect 1 If Target.Column = 10 Then Cells(Target.Row, 12).Value = Date & " " & Time Range("L:L").EntireColumn.AutoFit ElseIf Target.Column = 20 Then Cells(Target.Row, 24).Value = Date & " " & Time Range("X:X").EntireColumn.AutoFit ElseIf Target.Column = 29 Then Cells(Target.Row, 32).Value = Date & " " & Time Range("X:X").EntireColumn.AutoFit End If ActiveSheet.Protect 1 Application.EnableEvents = True End Sub Sub salim() ActiveSheet.Unprotect "salim" lr = Cells(Rows.Count, 1).End(3).Row + 1 With ActiveSheet.Range("A2:b" & lr) .Cells.Locked = True .Cells.SpecialCells(xlCellTypeBlanks).Locked = False End With Columns("C:xfd").Locked = False ActiveSheet.Protect "salim" End Sub

أخي الكريم سليم ليس إصرار ولكنه محاولة بسيطة لتحسين أوضاعي عموماً إليك الكود المستخدم Sub DeleteRows() Dim LR As Long, I As Long LR = Cells(Rows.Count, "J").End(xlUp).Row For I = LR To 2 Step -1 If InStr(Cells(I, "J"), "_______") > 0 Then Cells(I, "J").Offset(-1).Resize(18, 1).EntireRow.Delete End If Next I End Sub تقبل تحياتي

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

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

أخي الكريم عند النقر على الرابط يظهر صفحات دعائية عدد من المرات حوالي 4 مرات في كل مرة يظهر كلمة Skip Ad بعد 5 ثواني في أعلى يمين الصفحة إذا لم تستطع سأقوم بتحميله لك إن شاء الله ..فقط كرر المحاولة

أخي الكريم الزعيم يوسف إليك ما طلبت إن شاء الله ، حيث يتم حذف الصف الذي يحتوي النص والصف السابق له و16 صف تالية له أي مجموع 18 صف متتالي .. حمل الملف من هنا

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

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

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

جرب التعديل بهذا الشكل Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim Cl As Variant, Dat As Variant Dim DupCtr As Double Dim LastRow As Long If Not Application.Intersect(Target, Columns("A:A")) Is Nothing Then Application.EnableEvents = False If Target.Cells.Count > 1 Then Dat = Target.Formula For Each Cl In Dat If Cl <> "" Then MsgBox "Change Only One Cell At A Time", , "Too Many Changes!" Application.Undo: Application.CutCopyMode = False GoTo Skipper End If Next Cl End If End If Skipper: Application.EnableEvents = True If Target.Column = 10 Then Application.EnableEvents = False ActiveSheet.Unprotect 1 Cells(Target.Row, 12).Value = Date & " " & Time Range("L:L").EntireColumn.AutoFit ActiveSheet.Protect 1 Application.EnableEvents = True End If If Target.Column = 20 Then Application.EnableEvents = False ActiveSheet.Unprotect 1 Cells(Target.Row, 24).Value = Date & " " & Time Range("X:X").EntireColumn.AutoFit ActiveSheet.Protect 1 Application.EnableEvents = True End If If Target.Column = 29 Then Application.EnableEvents = False ActiveSheet.Unprotect 1 Cells(Target.Row, 32).Value = Date & " " & Time Range("X:X").EntireColumn.AutoFit ActiveSheet.Protect 1 Application.EnableEvents = True End If End Sub تقبل تحياتي

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

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

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

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

أخي الكريم أسامة قم بحذف الأكواد من موديولات أوراق العمل وضع هذا الكود في حدث المصنف فقط Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim Cl As Variant, Dat As Variant Dim DupCtr As Double Dim LastRow As Long If Not Application.Intersect(Target, Columns("A:A")) Is Nothing Then Application.EnableEvents = False If Target.Cells.Count > 1 Then Dat = Target.Formula For Each Cl In Dat If Cl <> "" Then MsgBox "Change Only One Cell At A Time", , "Too Many Changes!" Application.Undo: Application.CutCopyMode = False GoTo Skipper End If Next Cl End If End If Skipper: Application.EnableEvents = True If Target.Column = 10 Then Application.EnableEvents = False Sh.Unprotect 1 Sh.Cells(Target.Row, 12).Value = Date & " " & Time Sh.Range("L:L").EntireColumn.AutoFit ActiveSheet.Protect 1 Application.EnableEvents = True End If If Target.Column = 20 Then Application.EnableEvents = False Sh.Unprotect 1 Sh.Cells(Target.Row, 24).Value = Date & " " & Time Sh.Range("X:X").EntireColumn.AutoFit Sh.Protect 1 Application.EnableEvents = True End If If Target.Column = 29 Then Application.EnableEvents = False Sh.Unprotect 1 Sh.Cells(Target.Row, 32).Value = Date & " " & Time Sh.Range("X:X").EntireColumn.AutoFit Sh.Protect 1 Application.EnableEvents = True End If End Sub حيث سيعمل الكود بهذا الشكل مع كل أوراق العمل بدلاً من عمل الكود لكل ورقة عمل على حدا

أخي الكريم عبد العزيز الملف صعب في التعامل معه بسبب وجود خلايا مدمجة ، والطلب غير واضح بعض الشيء .. بعد ترحيل الطلبة الناجحون .. وعددهم كما في المرفق 16 طالب أي أن هناك 9 طلاب في ورقة 1 والباقي 7 سيكون في ورقة 2 .. ماذا عن الذين لهم دور ثان ! هل سيتم تكملة الترحيل في نفس الورقة 2 بعد آخر طالب ناجح أم أن الترحيل سيكون بداية من ورقة جديدة للذين لهم دور ثاني...؟