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

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


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

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

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

السلام عليكم

أخي محمد طاهر .. هذه دالة أخرى قد تكون أسرع وخصوصا للمدد (الفترات) الطويلة وذلك لعدم حاجة الدالة لاستخدام أي تكرار 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

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

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

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

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

Important Information