إحتساب الوقت الإضافي

[أبو جاسم]

السلام عليكم

ياجماعة انا محتاج حد يساعدني في التقرير المرفق

كل اللي انا محتاجه اني لما اكتب رقم الموظف اللي موجود في أي ورقة من الورقات الثلاثة الموجودين في الشيت المرفق يجبلي وقت الدخول ووقت الخروج وساعات العمل والساعات الزياده عن العمل علشان اقدر اعرف هو اشتغل كام ساعة وبالتالي اقدر احسبلة الوقت الإضافي بتاعه

ياريت حد يقدر يفيدني في الموضوع لاني تقريبا بشتغل على الموضوع يدوي

وانا واثق ان شاء الله اني هالاقي الموضوه هنا بسهوله لان بارك الله فيكم موجود ناس عباقرة كتير يقدرو يفيدوني

جزاكم الله خير

[ياسر خليل أبو البراء]

أخي الكريم محمد

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

ونصيحة لا تكثر من الملفات المرفقة المختلفة .. ركز على ملف مرفق واحد ويكون معبر عن الملف الأصلي

تقبل تحياتي

[أبو جاسم]

السلام عليكم

اسف انى مرفقتش الشيت

و ان شاء الله المرة دي أكون قدرت أوضح طلبي ويكون ان شاء الله الموضوع بسيط

وان شاء الله البركة فيكم

وبشكر الأستاذ ياسر خليل علي الاهتمام Overtime Report.rar

[ياسر خليل أبو البراء]

وعليكم السلام أخي الكريم محمد

إليك الكود التالي عله يفي بالغرض إن شاء الله

'Author : YasserKhalil
'Release : 25 - 08 - 2016

Sub Test()
    Dim Ws      As Worksheet
    Dim Sh      As Worksheet
    Dim I       As Long
    Dim J       As Long
    Dim Lr      As Long
    Dim Last    As Long

    Set Ws = Sheets("Sheet1")
    J = 3

    Application.ScreenUpdating = False
        With Ws.Range("A3:H1000"): .ClearContents: .Borders.Value = 0: End With
        If IsEmpty(Ws.Range("C1")) Then MsgBox "Employee Number Not Existing", vbExclamation: Exit Sub
        
        For Each Sh In ThisWorkbook.Worksheets
            If Sh.Name <> Ws.Name Then
                With Sh
                    Lr = .Cells(Rows.Count, 1).End(xlUp).Row
                    For I = 2 To Lr
                        If Not IsEmpty(.Cells(I, 1)) Then
                            If CDbl(.Cells(I, 1)) = CDbl(Ws.Cells(1, "C")) Then
                                Ws.Cells(J, 1) = Ws.Cells(J, 1).Row - 2
                                Ws.Cells(J, 2).Resize(1, 3).Value = Sh.Cells(I, 3).Resize(1, 3).Value
                                Ws.Cells(J, 5).Value = Sh.Cells(I, 12).Value
                                Ws.Cells(J, 6).Value = Sh.Cells(I, 10).Value
                                Ws.Cells(J, 7).Formula = "=TIME(8,,)"
                                Ws.Cells(J, 8).Formula = "=IF(AND(F" & J & "="""",G" & J & "=""""),"""",IF(F" & J & ">G" & J & ",(F" & J & "-G" & J & "),0))"
    
                                J = J + 1
                            End If
                        End If
                    Next I
                End With
            End If
        Next Sh
    
        If J < 4 Then MsgBox "No Employee With That Number", 64: Exit Sub
    
        Last = IIf(Ws.Cells(Rows.Count, 1).End(xlUp).Row < 3, 2, Ws.Cells(Rows.Count, 1).End(xlUp).Row)
        With Ws.Range("A2:H" & Last): .Borders.Value = 1: End With
    Application.ScreenUpdating = True

    MsgBox "Done...", 64
End Sub

تقبل تحياتي

Overtime Report Loop Through All Sheets YasserKhalil.rar

[أبو جاسم]

استاذي العزيز ياسر خليل اشكرك بشده

فعلا انا عاجز عن الشكر واتمني اني اخدم حضرتك في اي شئ بجد

واتمني اني اكلم حضرتك على الخاص واحب اتواصل مع حضرتك

وشئ اخير اذا امكن

ازاي اطبق الكود ده 

يعني اذا فيه شيت جديد بتاريخ جديد اعمل ايه علشان اشغل الكود ده تاني عليها 

اذا ممكن شرح بسيط يساعدني

[ياسر خليل أبو البراء]

أخي الكريم محمد

الحمد لله أن تم المطلوب على خير ...

أولاً وقبل كل شيء لابد من تعلم الأساسيات للتعامل مع الأكواد .. 

إليك الرابط التالي فيه شرح وافي للبدايات إن شاء الله يفيدك

من هنا

 

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

 

بالنسبة للكود سيعمل مع إضافة أي ورقة عمل لديك .. أما إذا أردت استثناء ورقة عمل معينة فسيلزم التعديل في السطر التالي

If Sh.Name <> Ws.Name Then

على سبيل المثال إذا أضفت ورقة عمل جديدة وأسميتها Report وأردت ألا يطبق عليها عمل الكود فيكون السطر بالشكل التالي

If Sh.Name <> Ws.Name And Sh.Name <> "Report" Then

أي تضاف كلمة And لإضافة شرط جديد ثم تضع مقارنة بأن اسم ورقة العمل لا تساوي الكلمة Report >> أرجو أن تكون قد اتضحت الصورة

 

تقبل تحياتي