حساب عدد ايام الجمعة و السبت بين تاريخين

[محمد طاهر عرفه]

Function GetFRSAT(Mydate1 As Date, Mydate2 As Date) As Long


If Mydate2 < Mydate1 Then

Dim tempdate As Date

tempdate = Mydate1

Mydate1 = Mydate2

Mydate2 = tempdate

End If


 Dim Datediff As Long, vic As Long

 Datediff = Mydate2 - Mydate1 + 1

  vic = 0

 For i = 1 To Datediff

  If Weekday(Mydate1 + i - 1) > 5 Then vic = vic + 1

 Next i


 GetFRSAT = vic


End Function

تم تعديل المثال للمرة الثانية و الكود أعلاه بعد اضافة الأخ أبو هادي :

Sat_Fr_vications.zip

[أبو هادي]

السلام عليكم

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

هذه الدالة لحساب أي يوم من الإسبوع بين تاريخين :

Function CountWkDay(ByVal Date1 As Long, _

                    ByVal Date2 As Long, _

                    WkDay As Byte) As Variant

  Date1 = Date1 - 1

  Date1 = Fix((Date1 + (7 - WkDay)) / 7)

  Date2 = Fix((Date2 + (7 - WkDay)) / 7)

  CountWkDay = Date2 - Date1

End Function

وهذه دالة لحساب الجمعة والسبت تم فيها استخدام الدالة أعلاه :

Function GetFriSat(ByVal Date1 As Long, _

                   ByVal Date2 As Long)

  GetFriSat = CountWkDay(Date1, Date2, vbFriday) + _

              CountWkDay(Date1, Date2, vbSaturday)

End Function

تحياتي .

[محمد طاهر عرفه]

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

فكرة الدالة جميلة جدا ، و طبعا أسرع

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

و سأترك الدالة القديمة كمثال علي الكود فى نفس المثال :(

[أبو هادي]

السلام عليكم

شكرا لك أخي محمد طاهر ،

أرى بدلا من إعطاء رسالة ثم الخروج من الدالة أن تقوم الدالة نفسها بالتبديل بين التاريخين .

سأقوم بالتعديل على الدالة ووضعها من جديد .

تحياتي .

[أبو هادي]

الدالة بعد التعديل :

Function CountWkDay(ByVal Date1 As Long, _

                   ByVal Date2 As Long, _

                   WkDay As Byte) As Variant

 If Date1 <= Date2 Then

   Date1 = Date1 - 1

 Else

   Date2 = Date2 - 1

 End If


 Date1 = Fix((Date1 + (7 - WkDay)) / 7)

 Date2 = Fix((Date2 + (7 - WkDay)) / 7)

 CountWkDay = Abs(Date2 - Date1)

End Function

حاولت أن استخدام الخط السميك داخل الكود ولم يعمل فاضطررت للتعديل وحذف التحديد .

تم تعديل يوليو 5, 2003 بواسطه أبو هادي

[محمد طاهر عرفه]

تم تعديل المثال مرة أخري ، و نفذت استبدال التواريخ علي الدالة القديمة أيضا :d