AbuuAhmed

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

أوقات الصلاة

شكرا لمروركم ، صممتها لدالة حساب المدة فقط. تم التعديل على الدالة ولم أقم باختبارها بشكل موسع ، فالتجارب عليكم Function vbBetween(Value As Variant, Min As Variant, Max As Variant) As Boolean If VarType(Value) = VarType(Min) And _ VarType(Value) = VarType(Max) Then vbBetween = Value >= Min And Value <= Max End If End Function

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

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

تمت إضافة الكود على المثال: finish_02.rar

Function Between(inDate As Date, SP As Date, EP As Date) As Boolean Between = inDate >= SP And inDate <= EP End Function Public Function DatePeriod(ByVal StartDate As Date, ByVal EndDate As Date, _ Optional ByRef Per1 As Integer, _ Optional ByRef Per2 As Integer, _ Optional ByRef Per3 As Integer) As String Const SP1 = #1/1/1990#: Const EP1 = #9/6/2016# Const SP2 = EP1 + 1: Const EP2 = #9/30/2020# Const SP3 = EP2 + 1: Const EP3 = #1/1/2050# '------------------ If EndDate < StartDate Then GoTo Result If Not (Between(StartDate, SP1, EP3) Or _ Between(EndDate, SP1, EP3) Or _ Between(SP1, StartDate, EndDate) Or _ Between(EP3, StartDate, EndDate)) Then GoTo Result If StartDate < SP1 Then StartDate = SP1 If EndDate > EP3 Then EndDate = EP3 '------------------ If Between(StartDate, SP1, EP1) Then Per1 = DateDiff("w", StartDate, IIf(EP1 > EndDate, EndDate, EP1)) If EP1 < EndDate Then StartDate = SP2 Else GoTo Result End If If Between(StartDate, SP2, EP2) Then Per2 = DateDiff("m", StartDate, IIf(EP2 > EndDate, EndDate, EP2)) If EP2 < EndDate Then StartDate = SP3 Else GoTo Result End If Per3 = DateDiff("m", StartDate, IIf(EP3 > EndDate, EndDate, EP3)) Result: DatePeriod = Per1 & "," & Per2 & "," & Per3 End Function Sub DatePeriodTest() Dim Per1 As Integer, Per2 As Integer, Per3 As Integer Debug.Print " " & DatePeriod(DateSerial(1989, 9, 1), DateSerial(2050, 1, 1), Per1, Per2, Per3) Debug.Print Per1, Per2, Per3 End Sub إن شاء الله فهمت طلبك بشكل صحيح.

محاولة منى إذا فهمي لطلبك صحيح:

وهذه أيضا من عندي: If L Like "[0-9]" Then أو If L Like "[0123456789]" Then

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

هذه الدالة FRACTION.ANNEE غير موجودة عندي ربما أضيف حديثا في النسخ الحديثة.

لم تطلب اليوم ، طلبت فقط السنة والشهر تم إضافة اليوم Book13_03.rar

جرًب: Book13_02.rar

جرب test_02.xlsx

طلبك مو واضج ضع تواريخ مختلفة وضع الحالة يدويا بدون معادلة حتى نستطيع مقارنتها بما سنعمله. لاحظت أن ناتج الأعمدة A+B-C غالبا ناتجها بالسالب!

موضوع علمي شيق ومفيد ومسلي. موفقين جميعا.

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

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

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

بنظري هي الأصح أما الآخريات قد تتسبب في مشاكل عند حذف أحد الأكواد. لاحظت أكثركم عند استخدام دالة Nz يهمل قيمة False ، ما أدري متعمدين أو سقطت منكم سهوا.

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

أقرأ في الردود وما قدرت أفهم حلت المشكلة وإلا لا. أعتقد الحل موجود في هذه المشاركة بس لأني جديد ما أحد التفت لي 🙂 مثال : 1 تاريخ التعيين : 6 / 5 / 2022 تاريخ إنهاء الخدمة : 1 / 6 / 2022 شهر 5 فيه 31 يوم 31 - 5 = 26 يوم Day(DateSerial(2022, 5 + 1, 0)) - 6 + 1 مثال : 2 تاريخ التعيين 6 / 4 / 2022 تاريخ إنهاء الخدمة : 1 / 5 / 2022 شهر 4 فيه 30 يوم 30 - 5 = 25 Day(DateSerial(2022, 4 + 1, 0)) - 6 + 1 مثال : 3 تاريخ التعيين 6 / 2 / 2022 تاريخ إنهاء الخدمة 1 / 3 / 2022 شهر 2 في سنة 2022 فيه 28 يوم 28 - 5 = 23 يوم Day(DateSerial(2022, 2 + 1, 0)) - 6 + 1 مثال : 4 تاريخ التعيين 6 / 2 / 2020 تاريخ إنهاء الخدمة : 1 / 3 / 2020 شهر 2 في سنة 2020 فيه 29 يوم إذن 29 - 5 = 24 يوم Day(DateSerial(2020, 2 + 1, 0)) - 6 + 1

وضحت: جديد_02.xlsx

جرب وخبرنا احترت في جمع اليورو ، يوروات أو يورهات. تفقيط باليوزرفورم.xlsm

أتمى يكون هو المطلوب لأن سؤالك غير واضح جديد_01.xlsx