تطوير لدالة حساب العمر أو المدة

Hawiii · أبريل 15, 2020

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

Public Function YMD_Diff(inDate1 As Date, inDate2 As Date, _
                Optional outY, Optional outM, Optional outD, _
                Optional AddOneDay As Boolean = False) As String
    'تطوير لدالة YMDDif
    Dim inDate3 As Date
    Dim iYear As Integer
    Dim iMonth As Integer
    Dim iDay As Integer
    Dim dInterim1 As Date

    If inDate2 < inDate1 Then
        inDate3 = inDate1
        inDate1 = inDate2
        inDate2 = inDate3
    End If
    'AddOneDay عند الرغبة في إضافة يوم في العمر أو المدة
    inDate1 = inDate1 - Abs(AddOneDay)
    
    iMonth = DateDiff("m", inDate1, inDate2)
    If Day(inDate1) > Day(inDate2) Then
        iMonth = iMonth - 1
    End If
    dInterim1 = DateAdd("m", iMonth, inDate1)
    
    outD = DateDiff("d", dInterim1, inDate2)
    outM = iMonth Mod 12
    outY = iMonth \ 12
    
    YMD_Diff = outY & "y/" & outM & "m/" & outD & "d"
End Function



'إجراء لاختبار الدالة
Sub Test2()
   Dim Date1 As Date
   Dim Date2 As Date
   Dim Y As Integer, M As Byte, D As Byte
   
   Date1 = DateSerial(1970, 3, 1)
   Date2 = Date
   
   Debug.Print YMD_Diff(Date1, Date2)
   Debug.Print "--------------------"
   Debug.Print YMD_Diff(Date1, Date2, Y, M, D)
   Debug.Print Y, M, D
   Debug.Print "--------------------"
   Debug.Print YMD_Diff(Date1, Date2, Y, M, D, True)
   Debug.Print Y, M, D
   Debug.Print "--------------------"
End Sub

تم تعديل أبريل 15, 2020 بواسطه Hawiii

monm · أبريل 15, 2020

ياريت مثال تطبيق على كيفية استخدامها وشكرا

Hawiii · أبريل 15, 2020

7 ساعات مضت, monm said:

ياريت مثال تطبيق على كيفية استخدامها وشكرا

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

**ابو تراب** · أبريل 16, 2020

هلا اخي

شكرا على الدالة

ملاحظة سريعة

الدالة تعيد قيمة خطا كما في المثال التالي... فالقيمة المتوقعة 15 يوما بينما عادت 18 يوما

?YMD_Diff(DateSerial(1970, 3, 1),DateSerial(2020, 2, 15),,,,True) 
49y/11m/18d

عدلت في الكود الى التالي:

inDate2 = inDate2 + Abs(AddOneDay)

والنتيجة كالتالي:

?YMD_Diff(DateSerial(1970, 3, 1),DateSerial(2020, 2, 15),,,,True) 
49y/11m/15d

ملاحظة : لم اختبر الدالة بشكل مكثف

بالتوفيق

Hawiii · أبريل 22, 2020

في ١٦‏/٤‏/٢٠٢٠ at 22:00, ابو تراب said:

الدالة تعيد قيمة خطا كما في المثال التالي... فالقيمة المتوقعة 15 يوما بينما عادت 18 يوما

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

Public Function YMD_Diff(inDate1 As Date, inDate2 As Date, _
                Optional outY, Optional outM, Optional outD, _
                Optional AddOneDay As Boolean = False) As String
    Dim inDate3 As Date
    Dim iYear As Integer
    Dim iMonth As Integer
    Dim iDay As Integer
    Dim dInterim1 As Date
    
    'تصرف من Hawiii -------------------------------------
    If inDate2 < inDate1 Then
        inDate3 = inDate1
        inDate1 = inDate2
        inDate2 = inDate3
    End If
    
    Do While Month(inDate1) = 2 Or Month(inDate2) = 2 Or Month(inDate1 - 1) = 2
        inDate1 = DateAdd("m", 1, inDate1)
        inDate2 = DateAdd("m", 1, inDate2)
        'Debug.Print inDate1, inDate2
    Loop
    
    'AddOneDay عند الرغبة في إضافة يوم عند العمر أو المدة
    inDate1 = inDate1 - Abs(AddOneDay)
    'تصرف من Hawiii -------------------------------------
    
    iMonth = DateDiff("m", inDate1, inDate2)
    If Day(inDate1) > Day(inDate2) Then
        iMonth = iMonth - 1
    End If
    dInterim1 = DateAdd("m", iMonth, inDate1)
    
    outD = DateDiff("d", dInterim1, inDate2)
    outM = iMonth Mod 12
    outY = iMonth \ 12
    
    YMD_Diff = outY & "y/" & outM & "m/" & outD & "d"
End Function

**husamwahab** · أبريل 22, 2020

السلام عليكم استاذ Hawiii

جرب هذه الدالة

Root5000.rar

Hawiii · أبريل 23, 2020

في ٢٢‏/٤‏/٢٠٢٠ at 04:31, husamwahab said:

جرب هذه الدالة

جربت ، والآن دورك لتجرب هذه التواريخ:
Date1 = DateSerial(1970, 2, 28)
Date2 = DateSerial(1970, 3, 1)

Date1 = DateSerial(1970, 1, 31)
Date2 = DateSerial(1970, 3, 1)

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

لقد قمت بتعديل آخر على الدالة وربما تكون الأخيرة وربما لا:

Public Function YMD_Diff(inDate1 As Date, inDate2 As Date, _
                Optional outY, Optional outM, Optional outD, _
                Optional AddOneDay As Boolean = False) As String
    Dim iYear As Integer
    Dim iMonth As Integer
    Dim iDay As Integer
    Dim dInterim1 As Date
    
    'تصرف من Hawiii -------------------------------------
    Dim bkDate1 As Date, bkDate2 As Date
    
    bkDate1 = inDate1
    bkDate2 = inDate2
    
    If inDate2 < inDate1 Then
        inDate1 = inDate2
        inDate2 = bkDate1
    End If
    
    Do While Month(inDate1) = 2 Or Month(inDate2) = 2 Or Month(inDate1 - 1) = 2
      inDate1 = DateAdd("m", 1, inDate1)
      inDate2 = DateAdd("m", 1, inDate2)
    Loop
    
    'AddOneDay عند الرغبة في إضافة يوم في العمر أو المدة
    inDate1 = inDate1 - Abs(AddOneDay)
    bkDate1 = bkDate1 - Abs(AddOneDay)
    'تصرف من Hawiii -------------------------------------
    
    iMonth = DateDiff("m", inDate1, inDate2)
    If Day(inDate1) > Day(inDate2) Then
        iMonth = iMonth - 1
    End If
    dInterim1 = DateAdd("m", iMonth, inDate1)
    
    outD = DateDiff("d", dInterim1, inDate2)
    outM = iMonth Mod 12
    outY = iMonth \ 12
    
    'تصرف من Hawiii -------------------------------------
    If outY + outM = 0 Then outD = Abs(bkDate2 - bkDate1)
    'تصرف من Hawiii -------------------------------------
    
    YMD_Diff = outY & "y/" & outM & "m/" & outD & "d"
End Function

نصيحتي لمن يرغب في اختبار دوال العمر أو المدة أن يطبع نتائجها لمدة عام كامل مثلا من 01/01/2020 إلى 31/12/2020 مع تثبيت البداية والتبديل في النهاية ، فإذا تكررت نتيجتين فقط من أصل 366 يوم فهذا دليل على عدم متانة الدالة مع ملاحظة أن أحيانا النتائج نراها غير مقنعة عند مقارنتها بالنظر أو بالحسابات التقليدية.

**jjafferr** · أبريل 23, 2020

السلام عليكم 🙂

في ١٥‏/٤‏/٢٠٢٠ at 04:23, Hawiii said:

دالة رأيتها في مواضيع الأستاذ جعفر وأعجبتني كثيرا ، وحسب تعليقه في الموضوع أنها من ضمن ملف العون في محرر الـ VBA ولكني لم أستطع العثور عليها

الدالة موجودة في اكثر من موضوع ، منها :

.

وانا قلت:

اقتباس

هذه الوحدة النمطية الموجودة في Help الاكسس ، مع بعض التعديل

.

image.png.59e82f0f18255e2bcf827420f64bf6b0.png

.

في ١٦‏/٤‏/٢٠٢٠ at 23:00, ابو تراب said:
الدالة تعيد قيمة خطا كما في المثال التالي... فالقيمة المتوقعة 15 يوما بينما عادت 18 يوما
?YMD_Diff(DateSerial(1970, 3, 1),DateSerial(2020, 2, 15),,,,True) 
49y/11m/18d

.

لا تعليق لدي على دالة اخي Hawiii ونتائجها .

ولكن هناك خطأ في حساب اخوي ابو تراب ، فالمواقع التالية اعطتنا هذه النتائج:

image.png.7ce1f4263db2b5916cdf107464c308b0.png

.

و

image.png.b4dcd8ef337ee6d3d7f18fd7ac62653a.png

.

و

image.png.6db846f9a96942f3956141b084c822cf.png

.

عندما ادخلت هذه التواريخ على دالتي الاصلية ، حصلت على نفس النتيجة :

image.png.a2678e9616a6b622337370c253bb11d7.png

.

في ٢٢‏/٤‏/٢٠٢٠ at 04:34, Hawiii said:

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

هذا الكلام جدا خطير ، وغير مقبول على الاطلاق !!

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

المؤسسات وشركات العالم تدفع الملايين على برامجها حتى لا تقع في مثل هذا الخطأ ،

ونحن نرفع هذا الكود ، مثله مثل بقية الاكواد والبرامج التجريبية ، و نوادر وتجارب سنين ، بالمجان 🙂

شكرا للأخ الاستاذ @محمد طاهر ان وفر لنا هذا المنتدى ، و بالمجان ، لنساعد اخواننا في طلب العلم ، ونحصل على الثواب الجزيل 🙂

جعفر

**husamwahab** · أبريل 23, 2020

استاذ Hawiii

نعم كلامك صحيح واعتذر للاخوة الاساتذة والاعضاء على هذا الخطا

ارجو من ادارة المنتدى حذف المرفق

واجدد للجميع اعتذاري مرة اخرى

تم تعديل أبريل 23, 2020 بواسطه husamwahab

**jjafferr** · أبريل 23, 2020

18 دقائق مضت, husamwahab said:

نعم كلامك صحيح واعتذر للاخوة الاساتذة والاعضاء على هذا الخطا

ارجو من ادارة المنتدى حذف المرفق

واجدد للجميع اعتذاري مرة اخرى

اخي حسام 🙂

ليش الاعتذار ، هي تجربة انت قمت نها !!

جعفر

**husamwahab** · أبريل 23, 2020

حياك الله استاذ jjafferr

سبب الاعتذار انه قد يكون احد الاخوة اعتمد عليها معتقدا انها صحيحة

وانا السبب في ذلك لذلك قدمت اعتذاري

Hawiii · أبريل 23, 2020

وعليكم السلام ورحمة الله وبركاته.

44 دقائق مضت, jjafferr said:

لا تعليق لدي على دالة اخي Hawiii ونتائجها .

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

يعني لم أتدخل في نتائجها ، فهي ليست دالتي ولو هي دالتي فلن أستحي من وجود أخطاء في نتائجها ، ما مشكلتكم؟!!!

تعديلي الأخير هو تفادي (بعض أخطائها) وهو الهروب من شهر فبراير و عندما تقل المدة عن شهر أقوم بإرجاع الأيام بالشكل التقليدي فقط.

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

Hawiii · أبريل 23, 2020

تنقيح للمشاركة الأخرة ، كوني لم أستطع التعديل عليها:

Public Function YMD_Diff(inDate1 As Date, inDate2 As Date, _
                Optional outY, Optional outM, Optional outD, _
                Optional AddOneDay As Boolean = False) As String
    Dim iYear As Integer
    Dim iMonth As Integer
    Dim iDay As Integer
    Dim dInterim1 As Date
    
    'تصرف من Hawiii -------------------------------------
    Dim bkDate1 As Date, bkDate2 As Date
    
    bkDate1 = inDate1: bkDate2 = inDate2
    If inDate2 < inDate1 Then
        inDate1 = inDate2: inDate2 = bkDate1
    End If
    
    Do While Month(inDate1) = 2 Or Month(inDate2) = 2 Or Month(inDate1 - 1) = 2
      inDate1 = DateAdd("m", 1, inDate1)
      inDate2 = DateAdd("m", 1, inDate2)
    Loop
    
    'AddOneDay عند الرغبة في إضافة يوم في العمر أو المدة
    inDate1 = inDate1 + AddOneDay     'inDate1 - Abs(AddOneDay)
    'تصرف من Hawiii -------------------------------------
    
    iMonth = DateDiff("m", inDate1, inDate2)
    If Day(inDate1) > Day(inDate2) Then
        iMonth = iMonth - 1
    End If
    dInterim1 = DateAdd("m", iMonth, inDate1)
    
    outD = DateDiff("d", dInterim1, inDate2)
    outM = iMonth Mod 12
    outY = iMonth \ 12
    
    'تصرف من Hawiii -------------------------------------
    If outY + outM = 0 Then outD = Abs(bkDate2 - bkDate1) + Abs(AddOneDay)
    'تصرف من Hawiii -------------------------------------
    
    YMD_Diff = outY & "y/" & outM & "m/" & outD & "d"
End Function

**jjafferr** · أبريل 23, 2020

منذ ساعه, Hawiii said:

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

2. يعني لم أتدخل في نتائجها ، فهي ليست دالتي ولو هي دالتي فلن أستحي من وجود أخطاء في نتائجها ، ما مشكلتكم؟!!!

1. عملك كان شيء جديد وجميل ، وقمنا بالاعجاب به ،

2. المشكلة انك تقول انها انها ليست دالتك ، بينما انت الذي قمت بعمل التغيير عليها ، فنتائجها خاضعة لتغييراتك ،

لهذا السبب اردت ان اثبت لك ان دالتي الاصل (طبعا المأخوذة من مساعد الاكسس ، والتي عملت عليها تغييرات) تعطي النتائج الصحيحة.

جعفر

Hawiii · أبريل 23, 2020

10 دقائق مضت, jjafferr said:

2. المشكلة انك تقول انها انها ليست دالتك ، بينما انت الذي قمت بعمل التغيير عليها ، فنتائجها خاضعة لتغييراتك ،

واضح عندك مشكلة 🙂

12 دقائق مضت, jjafferr said:

لهذا السبب اردت ان اثبت لك ان دالتي الاصل (طبعا المأخوذة من مساعد الاكسس ، والتي عملت عليها تغييرات) تعطي النتائج الصحيحة.

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

**jjafferr** · أبريل 23, 2020

21 دقائق مضت, Hawiii said:

واضح عندك مشكلة 🙂

لا وانت الصادق ، قصدك واضح في مشكلة 🙂

كما ذكرت في مشاركتي السابقة ، الكود موجود في هذا الرابط :

Public Function YMDDif(sDate1, sDate2)

    'sdate1 earliest date sdate2 later

    Dim iYear As Integer
    Dim iMonth As Integer
    Dim iDay As Integer
    Dim dInterim1 As Date
    Dim D As Integer
    Dim M As Integer
    Dim Y As Integer

    iMonth = DateDiff("m", sDate1, sDate2)
    If Day(sDate1) > Day(sDate2) Then
        iMonth = iMonth - 1
    End If
    dInterim1 = DateAdd("m", iMonth, sDate1)
    iDay = DateDiff("d", dInterim1, sDate2)
    
    D = iDay
    M = iMonth Mod 12
    Y = iMonth \ 12
    
    YMDDif = CStr(Y) & " س/" & CStr(M) & " ش/" & CStr(D) & " ي"

End Function

جعفر

Hawiii · أبريل 23, 2020

فحص لفترتين فقط

Sub Test2()
   Dim Date1 As Date
   Dim Date2 As Date
   Dim yy As Integer, mm As Byte, dd As Byte
   
   Debug.Print "YMD_Diff", "YMDDif"
   
   Date1 = DateSerial(1970, 2, 28)
   Date2 = DateSerial(1970, 3, 1)
   Debug.Print YMD_Diff(Date1, Date2), YMDDif(Date1, Date2)
   
   Date1 = DateSerial(1970, 1, 31)
   Date2 = DateSerial(1970, 2, 27)
   Debug.Print YMD_Diff(Date1, Date2), YMDDif(Date1, Date2)
   
   'Debug.Print "--------------------"
   'Debug.Print YMD_Diff(Date1, Date2, yy, mm, dd)
   'Debug.Print yy, mm, dd
   'Debug.Print "--------------------"
   'Debug.Print YMD_Diff(Date1, Date2, yy, mm, dd, True)
   'Debug.Print yy, mm, dd
   'Debug.Print "--------------------"
End Sub

النتائج:
YMD_Diff      YMDDif
0y/0m/1d      0y/0m/4d
0y/0m/27d     0y/0m/30d

3 ساعات مضت, jjafferr said:

.

لاحظ أن النتائج هنا لا تخص الأصل ، أنت أتيت بنتائج لدالة معدلة اسمها YMDDif4

إذا أردت المزيد فأنا متفرغ لك اليوم ، آمرني بس وابشر بعزك.

Hawiii · أبريل 24, 2020

هذه دالة نشرها مبرمج اسمه "أبو هاجر" عام 2003 في منتديات الفريق العربي للبرمجة ويقول أنه حصل عليها من الإنترنت.
سوف أقوم بعمل مقارنات غدا إن شاء الله تعالى.

Function Age(DateFm As Date, DateTo As Date) As String
  Dim TempDate As Date
  Dim M As Long

  M = DateDiff("m", DateFm, DateTo)
  TempDate = DateAdd("m", M, DateFm)
  If TempDate > DateTo Then
    M = M - 1
    TempDate = DateAdd("m", M, DateFm)
  End If
   
  yy = Fix(M / 12)
  mm = M Mod 12
  dd = DateDiff("d", TempDate, DateTo)

 'Age = Format(yy, "00") & " - " & Format(mm, "00") & " - " & Format(dd, "00")
  Age = y & "y/" & M & "m/" & d & "d"
End Function

**jjafferr** · أبريل 24, 2020

السلام عليكم 🙂

لو تتبعت التاريخ لما يدخل في دالتي ، لوجدت انه غير الذي تم ارساله ، ولم استطع معرفة السبب !!

لهذا السبب ، استعمل نفس دالة التجربة التي استعملتها انت ، ولكن ارسل التواريخ الى دالتي اولا ثم الى دالتك ، وسترى ان النتيجة صحيحة ،

يعني :

بدلا عن ارسال التواريخ الى دالتك اولا
Debug.Print  YMD_Diff(Date1, Date2) , YMDDif(Date1, Date2)


ارسل التواريخ الى دالتي اولا
Debug.Print  YMDDif(Date1, Date2) , YMD_Diff(Date1, Date2)

.

جرب

Sub Test2()
   Dim Date1 As Date
   Dim Date2 As Date
   Dim yy As Integer, mm As Byte, dd As Byte
   
   Debug.Print  "YMDDif" ,"YMD_Diff"
   
   Date1 = DateSerial(1970, 2, 28)
   Date2 = DateSerial(1970, 3, 1)
   Debug.Print  YMDDif(Date1, Date2) , YMD_Diff(Date1, Date2)
   
   Date1 = DateSerial(1970, 1, 31)
   Date2 = DateSerial(1970, 2, 27)
   Debug.Print  YMDDif(Date1, Date2) , YMD_Diff(Date1, Date2)
   
   'Debug.Print "--------------------"
   'Debug.Print YMD_Diff(Date1, Date2, yy, mm, dd)
   'Debug.Print yy, mm, dd
   'Debug.Print "--------------------"
   'Debug.Print YMD_Diff(Date1, Date2, yy, mm, dd, True)
   'Debug.Print yy, mm, dd
   'Debug.Print "--------------------"
End Sub

.

لهذا السبب ، لما ارسلت التواريخ مباشرة الى الدالة ، كانت النتائج صحيحة :

.

------------------------------------------------------------------------------------------------

ولكن هذا الكلام كله صار بسبب قولك :

في ٢٢‏/٤‏/٢٠٢٠ at 04:34, Hawiii said:

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

وفي الواقع تم اثبات ان الاكسس لا يعطي نتائج خطأ بين التاريخين ،

وإنما الخطأ كان في دالتك اللي في اول مشاركة لك .

وللعلم ، فتجاربك في مشاركتك الاخيرة ، ليست على دالتك الاصل (والتي اثارت كل هذا النقاش) ، وانما على دالتك التي قمت بتعديلها 🙂

ومثل ما قلت سابقا ، طريقة عمل دالتك جميلة 🙂

جعفر

Hawiii · أبريل 24, 2020

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

لك مني اعتذاري وتقديري.
المفاجأة أن نتائج دالتك أتت بنفس نتائج دالتي التي قلت عنها معقدة فهي طويلة وأسطره زادت على 90 سطر.

الاختبار قبل الأخير:

Sub Test2()
   Dim Date1 As Date
   Dim Date2 As Date
   Dim sDate As Date
   Dim dd As Byte
   
   Debug.Print "YMD_Diff", " YMDDif", "  Age", "Hawiii"
   
   Date1 = DateSerial(1997, 1, 28)
   Date2 = DateSerial(2000, 2, 29)
   sDate = Date1
    
   For dd = 0 To 5
     Date1 = sDate + dd
     Debug.Print YMD_Diff(Date1, Date2), YMDDif(Date1, Date2), Age(Date1, Date2), GetAge(Date1, Date2)
   Next dd
End Sub


النتائج
YMD_Diff       YMDDif         Age         Hawiii
3y/1m/1d      3y/1m/1d      3y/1m/1d      3y/1m/1d
3y/1m/1d      3y/1m/0d      3y/1m/0d      3y/1m/0d
3y/1m/1d      3y/0m/30d     3y/1m/0d      3y/0m/30d
3y/1m/1d      3y/0m/29d     3y/1m/0d      3y/0m/29d
3y/0m/28d     3y/0m/28d     3y/0m/28d     3y/0m/28d
3y/0m/27d     3y/0m/27d     3y/0m/27d     3y/0m/27d

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

**jjafferr** · أبريل 24, 2020

18 دقائق مضت, Hawiii said:

لك مني اعتذاري وتقديري.

حياك الله 🙂

18 دقائق مضت, Hawiii said:

ولكن بما أن هذا الموضوع وترنا فلنتركه بنتيجة حاسمة

على بركة الله 🙂

جعفر

Hawiii · أبريل 24, 2020

الاختبار الأخير ومشاركتي الأخيرة ، ومبروك عليك الكأس من أبوآمنة 🙂
الاختبار لمدة سنة ، 🖐️

Sub Test2()
   Dim Date1 As Date, Date2 As Date
   Dim sDate As Date, eDate As Date
   Dim dd As Integer, Days As Integer
   
   Date1 = DateSerial(2019, 1, 28)
   Date2 = DateSerial(2020, 1, 29)
   sDate = Date1: eDate = Date2
   Days = Date2 - Date1
   
   Debug.Print "   From", "   To", " YMDDif", "  Hawiii"
   
   For dd = 0 To Days
     Date1 = sDate + dd
     If YMDDif(Date1, Date2) <> GetAge(Date1, Date2) Then
       Debug.Print Date1 & " - " & Date2, YMDDif(Date1, Date2), GetAge(Date1, Date2)
     End If
   Next dd
   
   Debug.Print "---------------------- End ------------------------"
   Date1 = DateSerial(2019, 3, 1)
   Debug.Print , , YMDDif(Date1 - 1, eDate), GetAge(Date1 - 1, eDate)
   Debug.Print , , YMDDif(Date1 + 0, eDate), GetAge(Date1 + 0, eDate)
   Debug.Print , , YMDDif(Date1 + 1, eDate), GetAge(Date1 + 1, eDate)
   Debug.Print "---------------------------------------------------"
   Date1 = DateSerial(2019, 4, 30)
   Debug.Print , , YMDDif(Date1 - 1, eDate), GetAge(Date1 - 1, eDate)
   Debug.Print , , YMDDif(Date1 + 0, eDate), GetAge(Date1 + 0, eDate)
   Debug.Print , , YMDDif(Date1 + 1, eDate), GetAge(Date1 + 1, eDate)
   Debug.Print "---------------------------------------------------"
End Sub

النتائج
From          To          YMDDif         Hawiii
01/03/2019 - 29/01/2020     0y/10m/28d    0y/11m/0d
30/04/2019 - 29/01/2020     0y/8m/30d     0y/8m/29d
30/06/2019 - 29/01/2020     0y/6m/30d     0y/6m/29d
30/09/2019 - 29/01/2020     0y/3m/30d     0y/3m/29d
30/11/2019 - 29/01/2020     0y/1m/30d     0y/1m/29d
---------------------- End ------------------------
                            0y/11m/1d     0y/11m/1d
                            0y/10m/28d    0y/11m/0d
                            0y/10m/27d    0y/10m/27d
---------------------------------------------------
                            0y/9m/0d      0y/9m/0d
                            0y/8m/30d     0y/8m/29d
                            0y/8m/28d     0y/8m/28d
---------------------------------------------------

**jjafferr** · أبريل 24, 2020

11 دقائق مضت, Hawiii said:

1. الاختبار الأخير

2.ومشاركتي الأخيرة ،

3.ومبروك عليك الكأس

4. من أبوآمنة 🙂

1. طيب وشو النتيجة ، انت ارفقت ارقام ، ولازم تشرحها ، شو الصح وليش ؟

2. هاي مو مقبولة (نعم مقبولة لهذا الموضوع) 🙂

3. ما منه فائدة بملاحظتك رقم 2 !!

4. حياك الله أبوآمنة 🙂

جعفر

Hawiii · أبريل 24, 2020

إنت مبرمج يفترض أنك تقرأ الكود والنتائج بكل سهولة.

خمس نتائج من أصل 366 فيها اختلاف بيننا ، ولتسهيل تمييز الصح من الخطأ أخذت أول خطأين من الخمسة وعملت عليهما مقارنة ثانية لإظهار نتيجة اليوم السابق ثم اليوم الذي به اختلاف ثم اليوم التالي.
وتحيات لأبي آمنة 🙂 .

**ابو تراب** · أبريل 26, 2020

في ٢٣‏/٤‏/٢٠٢٠ at 22:32, jjafferr said:

ولكن هناك خطأ في حساب اخوي ابو تراب ، فالمواقع التالية اعطتنا هذه النتائج:

.

الله يسلمك استاذ @jjafferr..ومعذرة على التاخر في الرد

الدالة صحيحة اذا لم يتم شمل اليوم الاخير...ولكن هناك ميزة ان اليوم الاخير يشمل كما في الموقع اتالي:

هنا عند اشمال التاريخ 15 فبراير 2020 في الحساب يتم اضافة يوم...بينما الدالة اعادت 18 يوما بدل 15.

لذلك هل يمكن اضافة هذه الميزة وهى اشمال التاريخ لدالتك الاصلية

تحياتي

.

تم تعديل أبريل 26, 2020 بواسطه ابو تراب

تسجيل الدخول

تطوير لدالة حساب العمر أو المدة

الردود الموصى بها

Hawiii

monm

Hawiii

ابو تراب

Hawiii

husamwahab

Hawiii

jjafferr

husamwahab

jjafferr

husamwahab

Hawiii

Hawiii

jjafferr

Hawiii

jjafferr

Hawiii

Hawiii

jjafferr

Hawiii

jjafferr

Hawiii

jjafferr

Hawiii

ابو تراب

Join the conversation

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information