أكاديمية الصقر للتدريب

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
هانى على لا تميز خلال هذه الفترة-- لا تميز خلال هذه الفترة YasserKhalil الترقيم بشرط معين اكسيل اسئله واجابات


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





معرفة ايام العمل بين تاريخين

قي هذا الملف 1-حدد تاريخ البداية وتاريخ النهاية 2- حدد ايام التعطيل العادية (جمعة سبت.......) 3 حدد تواريخ العطل الرسمي ..



29-08-2018 06:05 مساء
salim
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 33
قوة السمعة : 6607
عدد الإجابات: 67
 offline 

قي هذا الملف
1-حدد تاريخ البداية وتاريخ النهاية
2- حدد ايام التعطيل العادية (جمعة  سبت.......)
3 حدد تواريخ العطل الرسمية او القسرية (أعياد   مناسبات.....)
4- أضغط على الزر
ملاحظة:حسب تظام الجهاز قد تكتب التواريخ بصيغة dd/mm/yyy (نظام انكليزي)  او  mm/dd/yyy ( نظام اميركي)
الكود

Option Explicit
Sub give_date()
If ActiveSheet.Name <> "Main" Then GoTo Exit_Me
 With Application
  .ScreenUpdating = False
  .Calculation = xlCalculationManual
 End With
Dim t1 As Date: t1 = [b2]
Dim t2 As Date: t2 = [b3]
Dim Laste_Used_Col%: Laste_Used_Col = Cells(10, Columns.Count).End(1).Column
If Laste_Used_Col < 8 Then Laste_Used_Col = 8
Dim intreval%: intreval = t2 - t1 + 1
Dim My_Date As Date
Dim x$, xx%, i%, s%
Dim k%, r%, c%, t%, Z%, y%: r = 10: c = 8
Dim Final_col%
Dim lset_col%: lset_col = Cells(2, Columns.Count).End(1).Column
Dim rg_to_out As Range: Set rg_to_out = Range("i2").Resize(1, lset_col - 8)
Dim Normal_range As Range: Set Normal_range = Range("h2:h7")
Dim arab_day(1 To 7)
 arab_day(1) = "الأحد": arab_day(2) = "الإثنين": arab_day(3) = "الثلاثاء"
 arab_day(4) = "الأربعاء": arab_day(5) = "الخميس": arab_day(6) = "الجمعة"
 arab_day(7) = "السّبت"
Dim Eng_day(1 To 7)
 Eng_day(1) = "Sun": Eng_day(2) = "Mon": Eng_day(3) = "Tue": Eng_day(4) = "Wed"
 Eng_day(5) = "Thu": Eng_day(6) = "Fri": Eng_day(7) = "Sat"
Dim arab_month(1 To 12)
 arab_month(1) = "كانون الثّاني": arab_month(2) = "شباط": arab_month(3) = "آذار": arab_month(4) = "نيسان"
 arab_month(5) = "أيّار": arab_month(6) = "حزيران": arab_month(7) = "تـمّوز"
 arab_month(8) = "آب": arab_month(9) = "أيلول": arab_month(10) = "تشرين الأوّل"
 arab_month(11) = "تشرين الثّاني": arab_month(12) = "كانون الأوّل"
Dim Eng_Month(1 To 12)
   Eng_Month(1) = "Jan": Eng_Month(2) = "Feb": Eng_Month(3) = "Mar": Eng_Month(4) = "Apr"
   Eng_Month(5) = "May": Eng_Month(6) = "Jun": Eng_Month(7) = "Jul": Eng_Month(8) = "Aug"
   Eng_Month(9) = "Sep": Eng_Month(10) = "Oct": Eng_Month(11) = "Nov": Eng_Month(12) = "Dec"
   '========================================
   Range("h8").Resize(2, Laste_Used_Col - 7).Clear
   Range("h10:bz40").ClearContents
      '===============================
   My_Date = t1
  For k = 1 To intreval
   xx = Application.Match(Format(My_Date, "ddd"), Eng_day, 0)
   x = arab_day(xx)
y = Application.CountIf(Normal_range, x)
Z = Application.CountIf(rg_to_out, My_Date)
        If y + Z = 0 Then
            Cells(r, c) = My_Date: Cells(r, c + 1) = x
            r = r + 1
            s = s + 1
        End If
        If Month(My_Date) <> Month(My_Date + 1) Then r = 10: c = c + 2
        My_Date = My_Date + 1
     Next
     
     '==========================================
     Final_col = Cells(10, Columns.Count).End(1).Column
      If Final_col < 8 Then Final_col = 8
     For i = 8 To Final_col Step 2
       Cells(9, i) = arab_month(Month(Cells(9, i).Offset(1, 0)))
       Cells(9, i + 1) = Year(Cells(9, i).Offset(1, 0))
       Cells(8, i) = Application.Count(Range(Cells(10, i), Cells(45, i)))
     Next
     With Range("H8").Resize(2, Final_col - 7)
       With .Borders
        .LineStyle = 1
        .Weight = xlMedium
      End With
      With .Font
     .Name = "Arabic Typesetting"
     .Bold = True
     End With
     .HorizontalAlignment = xlCenter
     .Interior.ColorIndex = 6
     End With
     Range("j6") = s
     '=========================================
Exit_Me:
Erase arab_day: Erase Eng_day: Erase arab_month: Erase Eng_Month
   With Application
  .ScreenUpdating = True
  .Calculation = xlCalculationAutomatic
 End With
End Sub

الملف مرفق
 
 
 
  Works_Days.rar   تحميل rar مرات التحميل :(39)
الحجم :(164.864) KB


29-08-2018 10:06 مساء
مشاهدة مشاركة منفردة [1]
Eslam Abdullah
مشرف على لغات برمجة آخرى
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 03-10-2017
رقم العضوية : 852
المشاركات : 1580
الدولة : مصر
الجنس : ذكر
تاريخ الميلاد : 1-9-1995
الدعوات : 5
يتابعهم : 0
يتابعونه : 89
قوة السمعة : 10845
موقعي : زيارة موقعي
عدد الإجابات: 6
 offline 
look/images/icons/i1.gif معرفة ايام العمل بين تاريخين
جزاك الله خيرا استاذ سليم
واصل بلا فواصل 142

29-08-2018 11:11 مساء
مشاهدة مشاركة منفردة [2]
ali mohamed ali
مشرف على منتدى الاكسيل
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 20-11-2017
رقم العضوية : 1757
المشاركات : 1766
الدولة : مصر
الجنس : ذكر
الدعوات : 2
يتابعهم : 0
يتابعونه : 68
قوة السمعة : 9632
عدد الإجابات: 46
 offline 
look/images/icons/i1.gif معرفة ايام العمل بين تاريخين
أحسنت استاذ سليم بارك الله فيك وجزاك الله كل خير
توقيع :ali mohamed ali
{ وَقُل رَّبِّ زِدْنِي عِلْمًا }
[ كن على يقين من اعمالنا نخطئ ومن اخطائنا نتعلم ولذلك لا شي مستحيل ]
ساهم دائماً فى حل أى مشكلة او أستفسار لديك مع إضافة رد بشكره
أو دعوة لمن قدم اليك المساعدة,فالجميع هنا يعمل على مساعدة
 الاخرين لوجه الله وان تحتسب له اجر عند الله

30-08-2018 07:11 صباحا
مشاهدة مشاركة منفردة [3]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10445
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 535
قوة السمعة : 36552
عدد الإجابات: 254
 offline 
look/images/icons/i1.gif معرفة ايام العمل بين تاريخين
بارك الله فيك أخي العزيز سليم وجزاك الله خيراً
 

14-11-2018 08:46 صباحا
مشاهدة مشاركة منفردة [4]
بكار للأبد
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 17-01-2018
رقم العضوية : 3730
المشاركات : 282
الجنس : ذكر
تاريخ الميلاد : 13-9-1973
الدعوات : 2
يتابعهم : 6
يتابعونه : 10
قوة السمعة : 2206
 offline 
look/images/icons/i1.gif معرفة ايام العمل بين تاريخين
جزاك الله كل خير

20-11-2018 07:42 مساء
مشاهدة مشاركة منفردة [5]
ياسر فتحى البنا
عضو مشارك
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 04-09-2017
رقم العضوية : 346
المشاركات : 32
الدولة : مصر
الجنس : ذكر
تاريخ الميلاد : 25-10-1981
يتابعهم : 6
يتابعونه : 0
قوة السمعة : 115
 offline 
look/images/icons/i1.gif معرفة ايام العمل بين تاريخين

بارك الله فيك اخى الحبيب وجزاكم الله خير








الكلمات الدلالية
معرفة ، ايام ، العمل ، تاريخين ،


 










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

الساعة الآن 09:08 صباحا