ضم (Macro1) و (Macro2) معا وتوحيد البحث في شيت واحد

[algammal]

السادة الأفاضل الكرام خبراء أوفيسنا (Excel)

السلام عليكم جميعا ورحمة الله وبركاته

طبتم وطابت أوقاتكم بكل خير

وبعد

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

·       قمت بإنشاء: (Macro1) و (Macro2) و (Module3) و (Module4)؛ كما هو موضح بملف العمل المرفق حيث:   

·       شيت (search DATA) مرتبط بـ (Macro1) وهذا مبين في (Module3).

·       وشيت (search معاشات) مرتبط بـ (Macro2) وهذا مبين في (Module4).

·   المطلوب

·       أن يصبح شيت (SEARCH) هو شيت البحث الرئيس لما يحتويه شيت (search DATA) وشيت (search معاشات) ثم يتم حذف كلا الشيتين لعدم الحاجة إليهما.

·أو

·       ضم شيت (search معاشات) إلى شيت (search DATA) وحذف شيت (search معاشات) لعدم الحاجة إليه بعد أن يصبح شيت (search DATA) هو شيت البحث الرئيس وتغيير اسمه ليكون شيت (SEARCH).  

ملاحظة

·       أمكنني البحث بأي من محتويات الخلايا (M4:A4) ماعدا الخليتان: (G5) محافظة الميلاد (المظللة باللون الأصفر) و (K5) يوم الخروج للمعاش (المظللة باللون الأصفر)؛ ولا أعلم سببا لذلك؛ في كلا من شيتي: (search DATA) و (search معاشات).  

شاكر لكم حسن تعاونكم مسبقا ولكم خالص الشكر والتقدير والاحترام.

ضم ماكرو1 وماكرو2 معا وتوحيد البحث في شيت واحد.xlsb

[Foksh]

وعليكم السلام ورحمة الله وبركاته ,,

أشكرك على هذه الثقة أخي الفاضل @algammal ، وأتمنى ان نكون عند حسن الظن بها .. وطبعاً البركة في خبرائكم ومعلمينا الأفاضل هنا ، فأنا ما زلت اكتسب المعلومة في هذا الصرح الكبير .

 

بحد علمي وفهمي البسيط في اكسل ، قمت بدمج بيانات الشيتين (search DATA) و (search معاشات) في الشيت Search .

ثم جعلت الفلترة بشكلين ، إما عن موظف محدد باسمه مثلاً أو رقمه القومي كبيانات فريدة ( افتراضاً مني ) ، أو الفلترة الشاملة كما في الصورة :-

 

واستخدمت الماكرو الأول للـ بحث عن سجل محدد :-

Sub SearchOne()
    Dim ws As Worksheet
    Dim findRange As Range
    Dim searchCol As Long
    Dim searchValue As String
    Dim foundCell As Range
    Dim lastRow As Long
    
    Set ws = ThisWorkbook.Sheets("SEARCH")
    
    For searchCol = 1 To 13
        If Not IsEmpty(ws.Cells(5, searchCol)) Then
            searchValue = ws.Cells(5, searchCol).Value
            
            lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
            Set findRange = ws.Range(ws.Cells(10, searchCol), ws.Cells(lastRow, searchCol))
            
            Set foundCell = findRange.Find(What:=searchValue, LookIn:=xlValues, LookAt:=xlWhole)
            
            If Not foundCell Is Nothing Then
                ws.Range(foundCell.EntireRow.Address).Copy
                ws.Range("A5").PasteSpecial xlPasteValues
                Exit For
            End If
        End If
    Next searchCol
    
    Application.CutCopyMode = False
End Sub

 

وفي زر الفلترة الشاملة :-

Sub SearchAlls()
    Dim ws As Worksheet
    Dim searchCol As Long
    Dim searchValue As String
    Dim lastRow As Long
    
    Set ws = ThisWorkbook.Sheets("SEARCH")
    
    If ws.AutoFilterMode Then ws.AutoFilterMode = False
    
    For searchCol = 1 To 13
        If Not IsEmpty(ws.Cells(5, searchCol)) Then
            searchValue = ws.Cells(5, searchCol).Value
            
            lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
            ws.Range("A9:M" & lastRow).AutoFilter
            ws.Range("A9:M" & lastRow).AutoFilter Field:=searchCol, Criteria1:=searchValue
            
            Exit For
        End If
    Next searchCol
End Sub

 

وفي زر مسح الفلترة :-

Sub ClearSearch()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("SEARCH")
    
    If ws.AutoFilterMode Then ws.AutoFilterMode = False
    
    ws.Range("A5:M5").ClearContents
End Sub

 

هذا بحد فهمي للمطلوب ، وأرجو ان لا أكود قد صوبت إجابتي بشكل بعيد كلياً عن المطلوب ,🙃,

 

الملف بعد التعديل :-

توحيد البحث في شيت واحد.xlsb

 

جرب النتائج ، وأخبرني بها .