تعديل معادلة حسابية الى الافضل

[أبو إبراهيم الغامدي]

في 6‏/5‏/2022 at 16:29, محمد احمد لطفى said:

ممكن مساعدة أستاذى @أبو إبراهيم الغامدي

أهلا محمد...

أعتذر منك لأني لم استجب لنداءك

قمت بالتوفيق بين أفكار الزملاء بالحل المرفق..

Option Compare Database
Option Explicit

Public Const SP1 = #1/1/1990#
Public Const EP1 = #9/6/2016#
Public Const SP2 = #9/7/2016#
Public Const EP2 = #9/30/2020#
Public Const SP3 = #9/30/2020#
Public Const EP3 = #1/1/2050#

Public Function DatePeriod(StartDate, EndDate, Interval)

   Dim Periods(1 To 3) As Variant
   
   If (StartDate >= SP1) And (EndDate <= EP1) Then
      Periods(1) = DateDiff("w", StartDate, EndDate)
   ElseIf (StartDate < SP1) And (EndDate <= EP1) Then
      Periods(1) = DateDiff("w", SP1, EndDate)
   ElseIf (StartDate < SP1) And (EndDate > EP1) Then
      Periods(1) = DateDiff("w", SP1, EP1)
   Else
      Periods(1) = 0
   End If
   
   If (StartDate >= SP2) And (EndDate <= EP2) Then
      Periods(2) = DateDiff("m", StartDate, EndDate)
   ElseIf (StartDate < SP2) And (EndDate <= EP2) Then
      Periods(2) = DateDiff("m", SP2, EndDate)
   ElseIf (StartDate < SP2) And (EndDate > EP2) Then
      Periods(2) = DateDiff("m", SP2, EP2)
   ElseIf (StartDate >= SP2) And (EndDate > EP2) Then
      Periods(2) = DateDiff("m", StartDate, EP2)
   Else
      Periods(2) = 0
   End If
   
   If (StartDate >= SP3) And (EndDate <= EP3) Then
      Periods(3) = DateDiff("m", StartDate, EndDate)
   ElseIf (StartDate >= SP3) And (EndDate > EP3) Then
      Periods(3) = DateDiff("m", StartDate, EP3)
   Else
      Periods(3) = 0
   End If
   DatePeriod = Periods(Interval)
End Function

finish .mdb

[محمد احمد لطفى]

جزاك الله خيرا أستاذى @أبو إبراهيم الغامدي

عند حساب  كل فترة بفترتها تعمل

و لكن عند حساب من الشريحة الاولى الى الشريحة الثانية أو الثالثة أو من الشريحه الثانية الى الثالثة يحسب فقط الشريحة الثانية 

[أبو إبراهيم الغامدي]

29 دقائق مضت, محمد احمد لطفى said:

و لكن عند حساب من الشريحة الاولى الى الشريحة الثانية أو الثالثة أو من الشريحه الثانية الى الثالثة يحسب فقط الشريحة الثانية 

آسف على هذا القصور.. هناك حالة لم أقوم بعالجتها في الشريحة الألى..

Option Compare Database
Option Explicit

Public Const SP1 = #1/1/1990#
Public Const EP1 = #9/6/2016#
Public Const SP2 = #9/7/2016#
Public Const EP2 = #9/30/2020#
Public Const SP3 = #9/30/2020#
Public Const EP3 = #1/1/2050#

Public Function DatePeriod(StartDate, EndDate, Interval)

   Dim Periods(1 To 3) As Variant
   
   If (StartDate >= SP1) And (EndDate <= EP1) Then
      Periods(1) = DateDiff("w", StartDate, EndDate)
   ElseIf (StartDate < SP1) And (EndDate <= EP1) Then
      Periods(1) = DateDiff("w", SP1, EndDate)
   ElseIf (StartDate < SP1) And (EndDate > EP1) Then
      Periods(1) = Abs(DateDiff("w", SP1, EP1))
   ElseIf (StartDate >= SP1) And (EndDate > EP1) Then
      Periods(1) = IIf(DateDiff("w", StartDate, EP1) < 0, 0, DateDiff("w", StartDate, EP1))
   Else
      Periods(1) = 0
   End If
   
   If (StartDate >= SP2) And (EndDate <= EP2) Then
      Periods(2) = DateDiff("m", StartDate, EndDate)
   ElseIf (StartDate < SP2) And (EndDate <= EP2) Then
      Periods(2) = DateDiff("m", SP2, EndDate)
   ElseIf (StartDate < SP2) And (EndDate > EP2) Then
      Periods(2) = DateDiff("m", SP2, EP2)
   ElseIf (StartDate >= SP2) And (EndDate > EP2) Then
      Periods(2) = DateDiff("m", StartDate, EP2)
   Else
      Periods(2) = 0
   End If
   
   If (StartDate >= SP3) And (EndDate <= EP3) Then
      Periods(3) = DateDiff("m", StartDate, EndDate)
   ElseIf (StartDate >= SP3) And (EndDate > EP3) Then
      Periods(3) = DateDiff("m", StartDate, EP3)
   Else
      Periods(3) = 0
   End If
   DatePeriod = Periods(Interval)
End Function

finish .mdb

أرجو التأكد من صحة البيانات مع مزيد من الإدخالات حتى يتسنى مععالجتها

[محمد احمد لطفى]

أستاذى @أبو إبراهيم الغامدي

الشريحة الثالثة لم تظهر كذلك

 

[محمد احمد لطفى]

أستاذى @أبو إبراهيم الغامدي

عندتجربة حساب من 1-1-1990 حتى 1-1-1991 ظهر فى الشريحة الثانية -308 شهر
عند تجربة حساب من 1-1-2021 حتى 1-1-2022 ظهر فى الشريحة الثانية - 4 شهر

[أبو إبراهيم الغامدي]

عزيزي @محمد احمد لطفى

القيم السالبة ناتجة عن الاشتراطات المتعارضة بين الشرائج، وأتوقع وجود المزيد منها مع تنوع الإدخالات!

يمكن معالجة هذا القصور باستخدام عبارة ()IIF كما في الحالات السابقة..

finish .mdb

 

[محمد احمد لطفى]

أستاذى @أبو إبراهيم الغامدي 

الشريحة الثالثة لم تظهر
 

[AbuuAhmed]

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

 

تم تعديل أغسطس 27, 2022 بواسطه AbuuAhmed

[AbuuAhmed]

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

إن شاء الله فهمت طلبك بشكل صحيح.

 

تم تعديل أغسطس 27, 2022 بواسطه AbuuAhmed

[أبو إبراهيم الغامدي]

4 ساعات مضت, محمد احمد لطفى said:

الشريحة الثالثة لم تظهر

لأن بداية الفترة الثالثة في المثال تبدأ من 1-10-2020 وليست 30-9-2020! قم بتغييرها حسب متطلباتك

[AbuuAhmed]

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

 

finish_02.rar

[محمد احمد لطفى]

شكرً لمشاركتك أخى @AbuuAhmed
جزاك الله خيراً و لكنى مستمر مع أستاذى @أبو إبراهيم الغامدي  لأنها أبسط و يمكننى التعديل عليها 

أستاذى @أبو إبراهيم الغامدي

أسف و لكن عند حساب الشريحة الثالثة لوحدها تظهر و لكن عند حسابها من الشريحة الأولى أو الثانية لا تظهر 
مرفق المثال
 

 

finish (5).mdb

تم تعديل أغسطس 27, 2022 بواسطه محمد احمد لطفى

[أبو إبراهيم الغامدي]

14 دقائق مضت, محمد احمد لطفى said:

أسف و لكن عند حساب الشريحة الثالثة لوحدها تظهر و لكن عند حسابها من الشريحة الأولى أو الثانية لا تظهر 

صدقت! لأن هناك حالتين في الشريحة الثالثة لم أقوم بإدراجها! والتي أشرتَ إليها واحدة منها..

والأخيرة أن تكون الحالة أصغر من بداية الفترة وأكبر من نهاية الفترة.. بمعنى أنها مفتوحة الطرفين.. وهذه لا أتوقع حدوثها لأن نهاية الفترة الثالثة 2050!

finish (5).mdb

[محمد احمد لطفى]

أستاذى العزيز @أبو إبراهيم الغامدي

ظهرت فى الشريحة الثالثة ارقام بالسالب  حاولت تكرار ما سبق فى الشرائح الاخرى بائت بالفشل

 

[أبو إبراهيم الغامدي]

10 ساعات مضت, أبو إبراهيم الغامدي said:

القيم السالبة ناتجة عن الاشتراطات المتعارضة بين الشرائج، وأتوقع وجود المزيد منها مع تنوع الإدخالات!

يمكن معالجة هذا القصور باستخدام عبارة ()IIF كما في الحالات السابقة..

للتذكير فقط .. سهلة! 

finish (5).mdb

 

[محمد احمد لطفى]

جزاك الله خيرا أستاذى @أبو إبراهيم الغامدي

 

[AbuuAhmed]

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

 

[محمد احمد لطفى]

أستاذى @AbuuAhmed

كما قلت أنها أبسط قليلا و يمكنن أن أعدلها هذا بسببى أنا ليس أكثر 

و لو كان يمكننى أن اختار أكثر من إجابة كنت أضفت إجابت حضرتك لانها تعمل 

و ممكن حضرتك توضح أين الخطأ 

[AbuuAhmed]

7 ساعات مضت, محمد احمد لطفى said:

و ممكن حضرتك توضح أين الخطأ 

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

[ابوخليل]

في 27‏/8‏/2022 at 04:17, AbuuAhmed said:

Function Between(inDate As Date, SP As Date, EP As Date) As Boolean
  Between = inDate >= SP And inDate <= EP
End Function

اعجبني صنعك لهذه الدالة .. اذ لا وجود لها في vba .. شكرا لك يابواحمد

ولكن بالمقابل هي موجودة فعلا ويتعامل معها اكسس في الاستعلام ، لذا لو تم تمييزها بزيادة حرف او نقصه لكانت آمن واتقن لدى من يقتبسها .

[AbuuAhmed]

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

لذا لو تم تمييزها بزيادة حرف او نقصه لكانت آمن واتقن لدى من يقتبسها

شكرا لمروركم ، صممتها لدالة حساب المدة فقط.

تم التعديل على الدالة ولم أقم باختبارها بشكل موسع ، فالتجارب عليكم

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