شرح كود جلب بيانات بناء على قيمة معينة للرائع الأستاذ ياسر خليل أبو البراء

[أبو حنف]

هنا الكود 
ومرفق الملف

Option Explicit

'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

 

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

أخي الكريم أبو حنف

أين الملف المرفق ؟

 

حاول تتبع أسطر الكود واسأل عما استوقفك فقط لأن الشرح قد يستغرق وقت طويل وقد لا أملكه

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

تقبل تحياتي

[أبو حنف]

باختصار 

1- كود البحث مبني على القيم الموجودة في أول عامود  لو أردت تغيير عمود البحث فأين يمكنني التغيير ؟

2- ما فائدة هذا الشرط ؟ 

If CDbl(.Cells(I, 1)) = CDbl(Ws.Cells(1, "C"))

تم ارفاق الملف 

Overtime Report Loop Through All Sheets YasserKhalil 1.rar

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

أخي الكريم أبو حنف

كود البحث مبني على خلية واحدة فقط وهي الخلية C1 في ورقة العمل Sheet1 حيث يتم جلب البيانات بناءً على قيمة هذه الخلية

بالنسبة للنقطة الثانية

الشرط هو تساوي الرقم الموجود في الخلية C1 في ورقة العمل Sheet1 والتي يمثلها المتغير Ws (الشطر الأيمن من السطر) بالقيمة

أو الخلية في العمود الأول وقد يكون هذا هو إجابة سؤالك الأول حيث يمثل الرقم 1 في الشطر الأيسر رقم عمود البحث وهو العمود A ...

 

حلقة تكرارية لكل صف من صفوف ورقة العمل التي يتم البحث فيها ، والبحث في العمود الأول

أرجو أن تكون قد اتضحت الصورة قليلاً

واسأل ولا تخجل ، وحتى لو كررت السؤال فلن أمل

حاول تفهم كيف تسير الأمور ..استخدم مفتاح F8 لتتبع أسطر الكود سطر بسطر ومحاولة معرفة ما يجري

تقبل تحياتي

 

[أبو حنف]

عند تعديل عامود البحث للعامود 4 فما فوق يعطيني خطأ أخي ياسر 

                            If CDbl(.Cells(I, 4)) = CDbl(Ws.Cells(1, "C")) Then

 

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

أخي الكريم أبو حنف

عندما يحدث خطأ تظهر رسالة فيها كلمة Debug ، وبالنقر عليها يتم نقلك لسطر باللون الأصفر موضع الخطأ ..حاول أن تنسخ السطر في حالة حدوث خطأ لتكون أكثر دقة

العمود الرابع يحتوي على توقيت وليس أرقام ومن ثم يعطيك الخطأ ..

اشرح ما تريده لنحاول مساعدتك ..

 

[أبو حنف]

شكرا أخي ياسر 
بعد محاولات عديدة وتتبع للخلل وجدت بغيتي

أنا كنت أبحث عن كلمات وأرقام وكان الخطأ عند البحث بواسطة كلمة ، ولكن بعد حذف "cdb1 " من السطر  حلت المشكلة

وتم تعديل السطر الى 

If (.Cells(I, (Range("b1").Value))) = (Range("C1")) Then

مرفق ملف لمن أراد الاستزادة

Overtime Report Loop Through All Sheets YasserKhalil 1.rar

وطلب أخير 
هل يمكن اختصار الكود من الأسطر والمتغيرات الغير ضرورية لملفي - ان وجدت - لسهولة التعديل بعد ذلك ؟؟