تعديل على دالة لحساب الفرق بين تاريخين

moho58 · يناير 28

السلام عليكم الأخوة الأفاضل في هذا المنتدى الجميل

أريد في هذا الموضوع التعديل على دالة لحساب الفرق بين تاريخين

مثلا :

عند حساب الفرق بين تاريخين تحصلت على النتيجة التالية: 60 سنة و 2شهر و 30 يوم

أريد عندما تكون عدد الأيام 30يوم تحسب 01 شهر

اي من المفروض النتيجة تكون هكذا 60 سنة و 3 شهر و 0يوم

الرجاء التعديل على الدالة لتصبح تحسب بهذه الطريقة (يعني 30 يوم تحول الى 01 شهر و تضاف مع الشهور)

وبارك الله فيكم


Function CalcAge(StartDate As Date, EndDate As Date) As String
    Dim years As Integer
    Dim months As Integer
    Dim days As Integer
    Dim intH As Integer
       intH = Int(DateDiff("m", StartDate, EndDate)) + _
              (EndDate < DateSerial(Year(EndDate), Month(EndDate), Day(StartDate)))
        years = Int(intH / 12)
    months = intH Mod 12
       days = DateDiff("d", DateAdd("m", intH, StartDate), EndDate)
    CalcAge = years & " سنة و " & months & " شهر و " & days & " يوم"
End Function

code.rar

تم تعديل يناير 28 بواسطه ابوخليل
تنسيق الكود

**Foksh** · يناير 28

تفضل التعديل

Function CalcAge(StartDate As Date, EndDate As Date) As String
    Dim years As Integer
    Dim months As Integer
    Dim days As Integer
    Dim totalMonths As Integer
    
    totalMonths = Int(DateDiff("m", StartDate, EndDate)) + _
                  (EndDate < DateSerial(Year(EndDate), Month(EndDate), Day(StartDate)))
    
    years = Int(totalMonths / 12)
    months = totalMonths Mod 12
    
    ' تحويل 30 يومًا إلى 01 شهر
    If days = 30 Then
        months = months + 1
        days = 0
    End If
    
    CalcAge = years & " سنة و " & months & " شهر و " & days & " يوم"
End Function

moho58 · يناير 28

16 ساعات مضت, Foksh said:

تفضل التعديل

Function CalcAge(StartDate As Date, EndDate As Date) As String
    Dim years As Integer
    Dim months As Integer
    Dim days As Integer
    Dim totalMonths As Integer
    
    totalMonths = Int(DateDiff("m", StartDate, EndDate)) + _
                  (EndDate < DateSerial(Year(EndDate), Month(EndDate), Day(StartDate)))
    
    years = Int(totalMonths / 12)
    months = totalMonths Mod 12
    
    ' تحويل 30 يومًا إلى 01 شهر
    If days = 30 Then
        months = months + 1
        days = 0
    End If
    
    CalcAge = years & " سنة و " & months & " شهر و " & days & " يوم"
End Function

مشكور أخي الكريم على الرد والمتابعة ومعذرة على التأخر في الرد

عند التجريب أخي لا يقوم بحساب عدد الأيام دائما يكون عدد الأيام يساوي صفر (0) وحتى لوكانت

مثلا:

48 سنة و 11 شهر و 0 يوم و هنا من المفروض 48 سنة 11 شهرو 5 يوم

52سنة و 10شهر و 0 يوم

60 سنة و 8 شهر و 0 يوم 60 سنة و 8 شهر و 3 يوم

اي إذا كان عدد الايام 30 يوم تصبح شهر واحد أما إذا كان عدد الايام أقل من 30 يوم تترك كما هي

وبارك الله فيك أخي وسامحني

تم تعديل يناير 28 بواسطه moho58

**Foksh** · يناير 28

54 دقائق مضت, moho58 said:

مشكور أخي الكريم على الرد والمتابعة ومعذرة على التأخر في الرد

عند التجريب أخي لا يقوم بحساب عدد الأيام دائما يكون عدد الأيام يساوي صفر (0) وحتى لوكانت

مثلا:

48 سنة و 11 شهر و 0 يوم و هنا من المفروض 48 سنة 11 شهرو 5 يوم

52سنة و 10شهر و 0 يوم

60 سنة و 8 شهر و 0 يوم 60 سنة و 8 شهر و 3 يوم

اي إذا كان عدد الايام 30 يوم تصبح شهر واحد أما إذا كان عدد الايام أقل من 30 يوم تترك كما هي

وبارك الله فيك أخي وسامحني

أرجو المعذرة أخي الكريم ،، تفضل هذا المرفق

Diff.accdb

**kkhalifa1960** · يناير 28

ممكن مشاركة بعد اذنكم . تفضلوا حاولتي . :fff:

DDAge.rar

moho58 · يناير 28

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

أرجو المعذرة أخي الكريم ،، تفضل هذا المرفق

Diff.accdb 1.72 \u0645\u064a\u062c\u0627 \u0628\u0627\u064a\u062a · 2 downloads

السلام عليكم

مشكور أخي وبارك الله فيك

بعد التجربة هناك اشكالية إذا كان عدد الأيام 30 يوم وعند تحويله إلى 01 شهر

مثال فقط:

التاريخ 1 : 29/05/1973

التاريخ الثاني: 28/01/2024

الفرق : هنا يعطي النتيجة: 50 سنة - 7 شهر - 18657 يوم كما في الصورة

ومن المفروض النتيجة الصحيحة: 50 سنة و 7 شهر و 30 يوم

هنا 30 يوم أريد أن تصبح 01 شهر لتكون النتيجة النهائية: 50 سنة و 7 شهر و 00 يوم

أخي من فضلك ممكن تعدل على الدالة التي وضعتها لأن هذه الدالة وبهذا الاسم عامل به استعلامات كثيرة و أريد أن أتركها هي .في هذه الاستعلامات

وبار الله فيك أخي الكريم

**Foksh** · يناير 28

4 دقائق مضت, moho58 said:

السلام عليكم

مشكور أخي وبارك الله فيك

بعد التجربة هناك اشكالية إذا كان عدد الأيام 30 يوم وعند تحويله إلى 01 شهر

مثال فقط:

التاريخ 1 : 29/05/1973

التاريخ الثاني: 28/01/2024

الفرق : هنا يعطي النتيجة: 50 سنة - 7 شهر - 18657 يوم كما في الصورة

ومن المفروض النتيجة الصحيحة: 50 سنة و 7 شهر و 30 يوم

هنا 30 يوم أريد أن تصبح 01 شهر لتكون النتيجة النهائية: 50 سنة و 7 شهر و 00 يوم

أخي من فضلك ممكن تعدل على الدالة التي وضعتها لأن هذه الدالة وبهذا الاسم عامل به استعلامات كثيرة و أريد أن أتركها هي .في هذه الاستعلامات

وبار الله فيك أخي الكريم

ابشر ، بتم التعديل وبرفق الملف

moho58 · يناير 28

2 ساعات مضت, kkhalifa1960 said:

ممكن مشاركة بعد اذنكم . تفضلوا حاولتي .

DDAge.rar 67.56 kB · 2 downloads

مشكور أخي الكريم على الرد والمتابعة

ممكن أخي الكريم تعدل على الدالة التي وضعتها لأن هذه الدالة وبهذا الاسم عامل به استعلامات كثيرة و أريد أن أتركها هي .في هذه الاستعلامات

وبار الله فيك أخي الكريم

**kkhalifa1960** · يناير 29

استاذ @moho58 يتم حساب فروق الأشهر هنا على أساس شهري، وليس حسب شهر التقويم كما هو الحال مع الدالة DateDiff. لما لها من اخطاء وثغرات . :fff:

**Foksh** · يناير 29

تأييداً لكلام الأستاذ @kkhalifa1960 ،

أرجو تجربة التعديل بهذا الكود ،

Private Sub Calc_Click()
نص3 = DateAdd("d", DateDiff("d", [بداية العمل], [نهاية العمل]) / 2, [بداية العمل])
    Dim startDate As Date
    Dim endDate As Date
    Dim years As Integer
    Dim months As Integer
    Dim days As Integer

    startDate = [بداية العمل]
    endDate = [نهاية العمل]

years = DateDiff("yyyy", startDate, endDate)
months = DateDiff("m", DateAdd("yyyy", years, startDate), endDate)
days = DateDiff("d", DateAdd("m", months, DateAdd("yyyy", years, startDate)), endDate)

If Day(endDate) < Day(startDate) Then
    months = months - 1
    days = DateDiff("d", DateAdd("m", months, DateAdd("yyyy", years, startDate)), endDate)
End If

If Month(endDate) < Month(startDate) Then
    months = 12 + Month(endDate) - Month(startDate)
End If

If Day(startDate) = Day(endDate) + 1 Then
    days = 0
End If
Dim result As String
result = years & " سنة " & months & " شهر " & days & " يوم"
    نص5 = result
    نص10 = days
    نص12 = months
    نص14 = years
End Sub

moho58 · يناير 29

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

تأييداً لكلام الأستاذ @kkhalifa1960 ،

أرجو تجربة التعديل بهذا الكود ،

Private Sub Calc_Click()
نص3 = DateAdd("d", DateDiff("d", [بداية العمل], [نهاية العمل]) / 2, [بداية العمل])
    Dim startDate As Date
    Dim endDate As Date
    Dim years As Integer
    Dim months As Integer
    Dim days As Integer

    startDate = [بداية العمل]
    endDate = [نهاية العمل]

years = DateDiff("yyyy", startDate, endDate)
months = DateDiff("m", DateAdd("yyyy", years, startDate), endDate)
days = DateDiff("d", DateAdd("m", months, DateAdd("yyyy", years, startDate)), endDate)

If Day(endDate) < Day(startDate) Then
    months = months - 1
    days = DateDiff("d", DateAdd("m", months, DateAdd("yyyy", years, startDate)), endDate)
End If

If Month(endDate) < Month(startDate) Then
    months = 12 + Month(endDate) - Month(startDate)
End If

If Day(startDate) = Day(endDate) + 1 Then
    days = 0
End If
Dim result As String
result = years & " سنة " & months & " شهر " & days & " يوم"
    نص5 = result
    نص10 = days
    نص12 = months
    نص14 = years
End Sub

مشكور أخي الكريم على الصبر والمتابعة

لقد قمت بالتجربة كمثال:

تاريخ1 : 01/06/2024

تاريخ 2: 31/12/2024

المدة: 0 سنة 6 شهر 30 يوم

ومن المفروض تكون هكذا: 0 سنة 7 شهر 00يوم

أخي بحكم اني مبتدأ جدا في الأكسيس

هل يمكن وضع هذا الكود في الدالة التي وضعتها أنا للتعديل عليها

أو وضع هذا الكود في دالة

تم تعديل يناير 29 بواسطه moho58
ارفاق الصورة

**ابوخليل** · يناير 29

في 28‏/1‏/2024 at 03:48, Foksh said:
تفضل التعديل
    
    ' تحويل 30 يومًا إلى 01 شهر
    If days = 30 Then
        months = months + 1
        days = 0
    End If

هذا الحل نموذجي ويحقق المطلوب 100%

في 28‏/1‏/2024 at 20:37, moho58 said:

عند التجريب أخي لا يقوم بحساب عدد الأيام دائما يكون عدد الأيام يساوي صفر (0) وحتى لوكانت

اي إذا كان عدد الايام 30 يوم تصبح شهر واحد أما إذا كان عدد الايام أقل من 30 يوم تترك كما هي

يجب ان تتأكد

انا جربت الكود يعمل على احسن وجه

اذا الايام 30 يجعلها صفر ويزيد 1 للشهور واذا كانت اقل يبقيها كما هي

واليك التطبيق

db1.accdb

**Foksh** · يناير 29

لتحقيق الهدف على ما اعتقد قم باضافة شرط آخر وهو :-

5 ساعات مضت, Foksh said:

If Day(startDate) = Day(endDate) + 1 Then
    days = 0
End If

قم باستبدال هذا الجزء بما يلي

If Day(startDate) = Day(endDate) + 1 Then
    days = 0
Elseif days > 30 Then
months = months + 1
days = days - 30
End If

جرب و وافني بالرد

moho58 · يناير 30

3 ساعات مضت, ابوخليل said:

هذا الحل نموذجي ويحقق المطلوب 100%

يجب ان تتأكد

انا جربت الكود يعمل على احسن وجه

اذا الايام 30 يجعلها صفر ويزيد 1 للشهور واذا كانت اقل يبقيها كما هي

واليك التطبيق

db1.accdb 456 kB · 3 downloads

نعم أستاذنا @ابوخليل شغال بامتياز - ربما أن لم أنتبه رغم أنني جربته الكود كثيرا

الحل كان فقط في إضافة إلى الدالة التي وضعته للتعديل عليها فقط الكود المبين أسفله

ولهذا كان النتيجة تأتي خطأ

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

@ابوخليل @Foksh @kkhalifa1960

ربي يجازيكم خير الجزاء وجعلها الله في ميزان حسناتكم

و ربي يبارك في هذا المنتدى الرائع و في القائمين و المشرفين عليه

و كذا في جميع أعضاءه إن شاء الله

  ' تحويل 30 يومًا إلى 01 شهر
    If days = 30 Then
        months = months + 1
        days = 0
    End If

تسجيل الدخول

تعديل على دالة لحساب الفرق بين تاريخين

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

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

Join the conversation

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

Important Information