حساب العمر سنة شهر يوم

[AbuuAhmed]

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

'  DateFm      DateTo       Period
'28/02/2010  01/02/2015    04-11-05

'01/03/2010  01/02/2015    04-11-04
'02/03/2010  01/02/2015    04-11-03
'03/03/2010  01/02/2015    04-11-02
'04/03/2010  01/02/2015    04-11-01
'05/03/2010  01/02/2015    04-11-00

'06/03/2010  01/02/2015    04-10-27

جربوا دوالكم وزودونا بنائجها.

تم تعديل يناير 29, 2024 بواسطه AbuuAhmed

[AbuuAhmed]

دالة من "أبو هاجر"
 

Function GetPeriod2(ByVal DateFm As Date, ByVal DateTo As Date, _
                    Optional yy As Integer, Optional mm As Byte, Optional dd As Byte) As String
  Dim TempDate As Date
  Dim m As Long
   
  DateFm = DateFm - 1

  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)

  GetPeriod2 = Format(yy, "00") & "-" & Format(mm, "00") & "-" & Format(dd, "00")
End Function

دالة من جعفر
 

Function YMDDif(ByVal sDate1 As Date, ByVal sDate2 As Date) As String
    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

    sDate1 = sDate1 - 1
    
    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)
    
    Y = iMonth \ 12
    m = iMonth Mod 12
    D = iDay
    
    YMDDif = Format(Y, "00") & "-" & Format(m, "00") & "-" & Format(D, "00")
End Function

دالة من "أبو هادي"
 

Function GetPeriod1(ByVal DateFm As Date, ByVal DateTo As Date, _
                    Optional yy As Integer, Optional mm As Byte, Optional dd As Byte) As String
  Dim yyFm As Long, yyTo As Long
  Dim mmFm As Integer, mmTo As Integer
  Dim ddFm As Integer, ddTo As Integer
  
  DateFm = DateFm - 1
  
  yyFm = Year(DateFm): mmFm = month(DateFm): ddFm = day(DateFm)
  yyTo = Year(DateTo): mmTo = month(DateTo): ddTo = day(DateTo)
  
  If ddFm = day(DateSerial(yyFm, mmFm + 1, 1) - 1) Then
    ddFm = 0: mmFm = mmFm + 1
  End If
  
  If ddTo = day(DateSerial(yyTo, mmTo + 1, 1) - 1) Then
    ddTo = 0: mmTo = mmTo + 1
  End If
  
  If ddTo - ddFm < 0 Then  '(1)
    ddTo = ddTo + day(DateSerial(yyTo, mmTo, 0)):   mmTo = mmTo - 1
    If ddTo - ddFm < 0 Then '(2)
      ddTo = ddTo + day(DateSerial(yyTo, mmTo, 0)): mmTo = mmTo - 1
    End If
  End If
  
  If mmTo < mmFm Then
    mmTo = mmTo + 12: yyTo = yyTo - 1
  End If
  
  yy = yyTo - yyFm
  mm = mmTo - mmFm
  dd = ddTo - ddFm
  GetPeriod1 = Format(yy, "00") & "-" & Format(mm, "00") & "-" & Format(dd, "00")
End Function

 

[lionheart]

Whar are the expected correct results exactly

I have tried UDF on my side and these are the results

04-11-04
04-11-00
04-10-30
04-10-29
04-10-28
04-10-27
04-10-26

 

[ميدو63]

السادة

ممكن شيت اكسيل للتطبيق ... شكرا

[AbuuAhmed]

  في 30‏/1‏/2024 at 06:47, lionheart said:

04-11-04
04-11-00

Expand  

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

[AbuuAhmed]

  في 30‏/1‏/2024 at 07:59, ميدو63 said:

ممكن شيت اكسيل للتطبيق

Expand  

 

Periods_Year_Month_Day_01.xlsmFetching info...

[ميدو63]

ألاستاذ/ ابو احمد

اشكرك على الشيت