AbuuAhmed

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

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

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

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

إلى المشرفين المحترمين: لماذا تم حذف هذه المشاركة المشار إليها في سؤالي!! حذف آخر كود منقح يحرف المناقشة عن مفهومها الصحيح!! وفيها خلاصة الحل (الزبدة). نسخة مع التحية إلى @محمد طاهر عرفه الكود المحذوف والمقصود في سؤالي أعلى المشاركة: Sub KeepZeroDuplicates() Dim ws As Worksheet, CheckRange As Range Dim data As Variant, checkCols As Variant Dim row1 As Long, row2 As Long Application.ScreenUpdating = False 'Set worksheet and last row Set ws = ActiveSheet 'Replace with your sheet name if needed row1 = ws.Cells(ws.Rows.count, "A").End(xlUp).row 'Store data in an array for efficient processing data = ws.Range("A1:E" & row1).Value 'Adjust range as needed 'Specify columns to check for duplicates checkCols = Array(1, 4, 5) 'Replace with column numbers 'Loop through data array For row1 = 2 To UBound(data) 'Start from second row For row2 = 2 To row1 - 1 DoEvents 'Check for duplicate in specified columns If IsDuplicate(data, row1, row2, checkCols) Then 'If Duplicate and zero quantity If data(row1, 3) = 0 Then ws.Cells(row1, 1) = "2Del" Exit For End If End If Next row2 Next row1 For row1 = UBound(data) To 2 Step -1 If Cells(row1, 1) = "2Del" Then Rows(row1).Delete Shift:=xlUp End If Next row1 Application.ScreenUpdating = True MsgBox "Done" End Sub Function IsDuplicate(data As Variant, row1 As Long, row2 As Long, checkCols As Variant) As Boolean Dim index As Long For index = LBound(checkCols) To UBound(checkCols) If data(row1, checkCols(index)) <> data(row2, checkCols(index)) Then Exit Function End If Next index IsDuplicate = True End Function

هل جربت الكود في مشاركتي قبل الأخيرة ولم ينجح؟!! عموما أنا حليت لك أكبر مشكلتين في الكود: أولهما مفتاح التكرار حيث بدلته من: checkCols = Array(1, 2, 3, 4, 5) إلى: checkCols = Array(1, 4, 5) وكذلك تبديل عملية الحذف بحيث تكون من الأخير إلى الأول وهنا لا تحتاج إلى ضبط متغير row1 بعد كل عملية حذف ولا نحتاج لمقاطعة حلقة التكرار. يفترض أنك تراعي تعبنا بدلا من أن تأخذ جزء من هنا وجزء من هناك ثم ترجع بعبارة رأيت المشكلة أو وجدت الحل. ميزة الحل السابق أن يحافظ على ترتيب الادخال. سؤال لك الخيار في الرد عليه: هل التعديلات من عملك أم هناك من تتواصل معه خارج المنتدى؟

جرب التعديل واختبره جيدا توزيع الدفعات_03.xlsx

إذا شعرت بثقل/بطء المعادلات يمكن تحويلها إلى كود فيجوال. توزيع الدفعات_02.xlsx

وهذا تنقيح للكود بطريقتي: Sub RemoveZeroDuplicates() Dim ws As Worksheet, count As Long Dim row As Long, lRow As Long Application.ScreenUpdating = False Sheets("Sheet3").Select Set ws = ActiveSheet With ws lRow = ActiveCell.SpecialCells(xlLastCell).row For row = lRow To 2 Step -1 If .Cells(row, 8) = "Yes" Then count = count + 1 .Rows(row).Delete Shift:=xlUp End If Next row End With Application.ScreenUpdating = True MsgBox "تم حذف " & count & " سجل" End Sub

فقط قبل نصف ساعة فهمت موضوعك، دائما عند تقديم مثال يجب تقديم الحل/الناتج المطلوب، بمعني تقول هذه المعادلة يفترض أن يكون جوابها هكذا. اختصرت لك كل هالمشقة والأكواد بسطر واحد فقط، آمل التجربة والعودة لنا بملاحظاتك. وبعد المزيد من التجارب أضفت سطر آخر 🙂 Function myRound(MainVal As Double, RoundVal As Double) As Double Dim Adj As Double Adj = (0.1 / RoundVal) * Sgn(MainVal) myRound = Round(MainVal / RoundVal + Adj) * RoundVal End Function وهذا سطر للاحتراز يمكن إضافته بداية الدالة عند الرغبة: If RoundVal < 10 Or RoundVal Mod 10 <> 0 Then Exit Function

حل آخر: بدل هذا السطر: X2 = MainVal \ RoundVal بهذا السطر: X2 = Fix(MainVal / RoundVal)

جرب محاولتي ولكن عملتها "عمياني"، ما أدري بالضبط المطلوب من الدالة ولكني أجريت كل العمليات على صفحة اكسل، اختبرها وخبرني حتى ولو وجدت حل آخر، ربما نستطيع تطبيق الفكرة على دوال كثيرة نتائجها تتجاوز نطاق متغيرات الـ vba. المصنف_03.xlsm

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

فكرة أخرى جنب فكرة الأستاذ طارق محمود بيانات الموظفين_02.xlsm

20 / 365.2425 * 354.367 240 / 365.2425 * 354.367

كل عام وأنتم بخير احرص تضيف الكود في موديول الصفحة نفسها أفضل من إضافته في موديول عام، أو أن تختار الصفحة الهدف أولا قبل تشغيل الكود. عدل في السطر بأن تضغ بعد علامة = رقم آخر سطر في الصفحة بدلا من الأمر مثلا: lRow = 300

بدل في رقم الإزاحة (2) واجعله 0 Cells(.Row, .Column + 2) = NewValue

محاولتي حسب فهمي التشغيل من الكود نفسه. الارقام والنصوص_02.xlsm

لا بأس عليك، أجر وعافية.

دالة round تعمل مع الأرقام الموجبة والسالبة بنفس الطريقة، لا تحتاج إلى استخدام دالة if

ضع مثال أو صورة للخطأ وأعتقد أنك فحصت المرفق رقم 2 وليس 3، حيث تم تبديل المرفق. وإذا كان الخطأ في رقم 3 فأنا أعتذر عن المواصلة.

أنا تخصصي أكسس أكثر منه اكسل. أضفت 3 وحدات نمطية (موديولات) لـ أبو هادي، من له قدرة في استخدام امكانيات الاكسل في استخدام تقويم أم القرى فليفدنا. هناك شرط يجب أن تنتبه له وهو خصائص خلايا التاريخ يجب أن تكون لتقويم أم القرى وإلا ستتفاجأ بنتائج خاطئة. فرق مدة إيجار بين تاريخين هجري_03.xlsm

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

حل عن طريق الـ vba، دالة لحساب أي يوم من الأسبوع بين تاريخين WeekDaysCount_01.xlsm

عدلت في المعادلة ربما تعمل معك، جرب =IF(F8*0.0199<1.99,1.99,IF(F8*0.0199>2.99,2.99,F8*0.0199))