اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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


moho58
إذهب إلى أفضل إجابة Solved by Foksh,

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

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

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

مثلا :

عند حساب الفرق بين تاريخين تحصلت على النتيجة التالية: 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

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

  • أفضل إجابة

تفضل التعديل

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

 

  • Like 2
رابط هذا التعليق
شارك

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 يوم تترك كما هي

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

تم تعديل بواسطه moho58
رابط هذا التعليق
شارك

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

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

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

مثلا:

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

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

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

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

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

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

 

Diff.accdb

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

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 يوم

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

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

 

 

 

1.jpg

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

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

السلام عليكم

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

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

مثال فقط:

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

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

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

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

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

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

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

 

 

 

1.jpg

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

  • Thanks 1
رابط هذا التعليق
شارك

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

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

DDAge.rar 67.56 kB · 2 downloads

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

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

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

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

تأييداً لكلام الأستاذ @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

 

  • Thanks 1
رابط هذا التعليق
شارك

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يوم

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

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

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

 

2.jpg

تم تعديل بواسطه moho58
ارفاق الصورة
رابط هذا التعليق
شارك

في 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

  • Thanks 2
رابط هذا التعليق
شارك

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

 

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

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

  • Thanks 1
رابط هذا التعليق
شارك

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
  • Thanks 1
رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



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

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information