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

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

أخي الكريم لا أحب أن يتم إرفاق أكثر من ملف في موضوع واحد (راجع موضوع التوجيهات في الموضوعات المثبتة في المنتدى) يرجى دائماً إرفاق ملف معبر عن الملف الأصلي حتى يتسنى للأعضاء تقديم الحل المناسب وحتى لا يطول الموضوع بدون داعي إليك الحل بعد التعديل الأخير أولاً قم بالضغط على Alt + F11 في محرر الأكواد من قائمة Insert اختر الأمر Module ثم ضع الكود التالي به Sub SplitIt() Dim I As Long, Arr1, Arr2, Delim Application.ScreenUpdating = False Arr1 = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value For I = LBound(Arr1) To UBound(Arr1) Cells(I, 7) = VBA.Split(Arr1(I, 1), " : ")(1) Next I Arr2 = Range("G1:G" & Cells(Rows.Count, 7).End(xlUp).Row).Value For I = LBound(Arr2) To UBound(Arr2) If InStr(Arr2(I, 1), " ، ") > 0 Then Delim = " ، " Else Delim = " , " Cells(I, 2) = VBA.Split(Arr2(I, 1), Delim)(0) Cells(I, 3) = VBA.Split(Arr2(I, 1), Delim)(1) Next I Columns(7).ClearContents Application.ScreenUpdating = True End Sub وأخيراً اذهب لورقة العمل واضغط Alt + F8 ستجد نافذة فيها اسم الماكرو SplitIt حدد اسم الماكرو وانقر الأمر Run لمزيد من التوضيح حول كيفية التعامل مع محرر الأكواد يرجى الإطلاع على الفهرس الموجود في توقيعي ستجد موضوع باسم "بداية الطريق لانقاذ الغريق" فيه البدايات للتعامل مع محرر الأكواد تقبل تحياتي

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

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

جرب الكود التالي Sub SplitIt() Dim I As Long, Arr1, Arr2, X Application.ScreenUpdating = False Arr1 = Range("E1:E" & Cells(Rows.Count, 5).End(xlUp).Row).Value For I = LBound(Arr1) To UBound(Arr1) Cells(I, 6) = Mid(VBA.Split(Arr1(I, 1), " : ")(1), 1, InStr(VBA.Split(Arr1(I, 1), " : ")(1), " ¡ ") - 1) Next I Application.ScreenUpdating = True End Sub Split Text YasserKhalil V2.rar

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

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

أخي الكريم عادل يفضل دائماً إرفاق ملف معبر عن الملف الأصلي جرب الكود التالي عله يفي بالغرض Sub SplitIt() Dim I As Long, Arr1, Arr2 Application.ScreenUpdating = False Arr1 = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value For I = LBound(Arr1) To UBound(Arr1) Cells(I, 7) = VBA.Split(Arr1(I, 1), " : ")(1) Next I Arr2 = Range("G1:G" & Cells(Rows.Count, 7).End(xlUp).Row).Value For I = LBound(Arr2) To UBound(Arr2) Cells(I, 2) = VBA.Split(Arr2(I, 1), " ، ")(0) Cells(I, 3) = VBA.Split(Arr2(I, 1), " ، ")(1) Next I Columns(7).ClearContents Application.ScreenUpdating = True End Sub تقبل تحياتي Split Text YasserKhalil.rar

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

أخي الكريم المشاكس .. لما لم تلبي نداء الأخ رجب جاويش بإرفاق الملف ..هل إرفاق الملف صعب لهذه الدرجة؟؟ تأكد أنك بإرفاقك للملف ستجد استجابة بشكل أفضل لأن الصورة تكون واضحة تماماً أما بدون ملف مرفق ندخل في دائرة احتمالات ويطول الموضوع بدون داعي لي رجاء آخر وهو تغيير اسم الظهور للغة العربية ليعبر عن شخصكم الكريم في انتظار الملف المرفق لتتضح صورة المطلوب بشكل أفضل وأخيراً أرجو أن يتسع صدرك لتعليمات وتوجيهات المنتدى بعد المشاركة لاحظت وجود الملف المرفق في المشاركة الأولى (وجب التنويه) جرب المعادلة التالية في الخلية G3 =IF(D3>C3,D3-C3,E3-C3) أو احتمال آخر =IF(D3>C3,D3-C3,D3+E3-C3) إذا لم يكن المطلوب يرجى إرفاق شكل النتائج المتوقعة تقبل تحياتي

معادلة غاية في الروعة أخي الحبيب رجب جاويش تسلم الأيادي وتعيش يا كبير كدا الموضوع أصبح رائع بمرورك الكريم ومعادلتك الرائعة ... تقبل تحياتي

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

أخي الكريم سامي الحميدي جرب الكود التالي عله يفي بالغرض Sub LoopThroughSheets() Dim Ws As Worksheet, Sh As Worksheet, I As Long, Cell As Range Set Ws = Sheet1 For Each Sh In ThisWorkbook.Worksheets For Each Cell In Sh.Range("E7:E" & Sh.Cells(Rows.Count, "B").End(xlUp).Row) If Not IsEmpty(Cell) And IsDate(Cell) And CLng(Date) - CLng(Cell) >= 30 Then Ws.Cells(I + 6, 1).Value = I + 1 Ws.Cells(I + 6, 2).Value = Sh.Name Ws.Cells(I + 6, 3).Value = Cell.Offset(, -3).Value Ws.Cells(I + 6, 4).Value = Cell.Value I = I + 1 End If Next Cell Next Sh End Sub تقبل تحياتي Loop Through Sheets & Check Date Condition YasserKhalil.rar

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

أخي الكريم أبو يحي جرب الكود التالي Sub Test() Dim Rng As Range On Error Resume Next Set Rng = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeConstants, 1) Rng.Copy Range("C1").PasteSpecial xlPasteValues Application.CutCopyMode = False End Sub تقبل تحياتي Use SpecialCells To Copy Numeric Values YasserKhalil.rar

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

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

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

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

وجزيت خيراً بمثل ما دعوت لي أخي الغالي عبد العزيز المدني تقبل تحياتي

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

أخي الحبيب أحمد لم أفهم مقصودك بالعمل دون اتصال ..ممكن توضح بالصور كيفية عمل ذلك؟ معلش هتقل عليك ..خصوصاً إن ورني تقيل (حاولت أعمل ريجيم لكن فشلت فشل ذريع)

تفضل الصورة التالية علها توضح لك

أخي الكريم عبد العزيز من التبويب View اختر الأمر page Layout ستجد التعامل مع ارتفاع الصفوف وعرض الأعمدة بالسنتيمتر تقبل تحياتي

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