ضم (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

 

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

[algammal]

أخي الفاضل الأستاذ / @Foksh

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

13 ساعات مضت, Foksh said:

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

 

لا عليك يا أخي؛ فلقد أصبت الهدف؛ يتبقى ملحوظة مهمة أرجو أن يتم أخذها بعين الاعتبار ألا وهي:

تحديث بيانات شيت (SEARCH) دوما بطريقة ديناميكية كلما تم تعديل في شيت (DATA) وشيت (معاشات).

وتقبل خالص شكري وتقديري؛ وجزاكم الله خير الجزاء؛ وبارك الله فيكم؛ ودمتم عونا لنا ولكل من أراد العون.

[Foksh]

منذ ساعه, algammal said:

أخي الفاضل الأستاذ / @Foksh

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

لا عليك يا أخي؛ فلقد أصبت الهدف؛ يتبقى ملحوظة مهمة أرجو أن يتم أخذها بعين الاعتبار ألا وهي:

تحديث بيانات شيت (SEARCH) دوما بطريقة ديناميكية كلما تم تعديل في شيت (DATA) وشيت (معاشات).

وتقبل خالص شكري وتقديري؛ وجزاكم الله خير الجزاء؛ وبارك الله فيكم؛ ودمتم عونا لنا ولكل من أراد العون.

حسناً ، سأرى ما يمكنني فعله عند عودتي للمنزل ان شاء الله مساءً ..

وقد نبحث عن حل آخر لحل مشكلة تتالي التحديث على البيانات

[Foksh]

19 ساعات مضت, algammal said:

تحديث بيانات شيت (SEARCH) دوما بطريقة ديناميكية كلما تم تعديل في شيت (DATA) وشيت (معاشات).

 

تم انشاء استدعاء لدالة للتحديث التلقائي عند فتح الشيت Search في ThisWorkbook كالآتي :-

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh.Name = "SEARCH" Then
        Call UpdateSearchSheet
        With ThisWorkbook.Sheets("SEARCH")
            .Range("B5").Select
        End With
    End If
End Sub

 

وطبعاً دالة التحديث التلقائي :-

Sub UpdateSearchSheet()
    Dim wsSearch As Worksheet
    Dim wsData As Worksheet
    Dim wsPensions As Worksheet
    Dim lastRowData As Long
    Dim lastRowPensions As Long
    Dim lastRowSearch As Long
    
    Set wsSearch = ThisWorkbook.Sheets("SEARCH")
    Set wsData = ThisWorkbook.Sheets("DATA")
    Set wsPensions = ThisWorkbook.Sheets("معاشات")
    
    wsSearch.Range("A10:M1000").ClearContents
    
    lastRowData = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row
    If lastRowData > 9 Then
        wsData.Range("A10:M" & lastRowData).Copy
        wsSearch.Range("A10").PasteSpecial xlPasteValues
    End If
    
    lastRowSearch = wsSearch.Cells(wsSearch.Rows.Count, "A").End(xlUp).Row
    If lastRowSearch < 10 Then lastRowSearch = 9
    lastRowPensions = wsPensions.Cells(wsPensions.Rows.Count, "A").End(xlUp).Row
    If lastRowPensions > 9 Then
        wsPensions.Range("A10:M" & lastRowPensions).Copy
        wsSearch.Range("A" & lastRowSearch + 1).PasteSpecial xlPasteValues
    End If
    
    Application.CutCopyMode = False
End Sub

 

وبشكل اختياري ، زر تحديث يدوي :-

Sub RefreshSearchData()
    Call UpdateSearchSheet
    With ThisWorkbook.Sheets("SEARCH")
        .Range("B5").Select
    End With
    MsgBox "تم تحديث البيانات بنجاح", vbInformation
End Sub

 

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

تم تعديل الأحد at 08:22 بواسطه Foksh
تصحيح خطأ مطبعي ،،

[algammal]

أخي الكريم الأستاذ / @Foksh

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

دعني أولا أثمن ما قمتم به من جهد واضح وملموس تستحقون الشكر كل الشكر والثناء عليه وإني لأطمع في رحابة وسعة صدركم وكلي أمل في أن تعيروني اصغاءكم لما لا حظته من خلال التجربة العملية حتى نصل لملف كامل النمو ويليق بخبراء أوفيسنا (Excel) الكرام ويستحق أن يستخدمه كل من يجد فيه ضالته المنشودة وألخص ما توصلت إليه ضمن ما يلي:

1)   التسلسل في شيت (SEARCH) نسي (5) الخمسة صفوف الأولى من شيت (DATA) وبدأ الترقيم من رقم (6)؛ والمفترض أن الخمسة صفوف الأولى من شيت (DATA) من (B5) وحتى (B9) تأخذ مكانها في شيت (SEARCH).

2)   لو أمعنا النظر في شيت (SEARCH) جيدا ولاحظنا أول اسم في الشيت لوجدناه في خلية (B10) بإسم (محمد 128)

3)   ولو لاحظنا آخر الشيت ذاته لوجدنا أن أسماء شيت (معاشات) مكررة فيه بداية من خلية (B7855) بإسم (محمد 98) وحتى خلية (B7871) باسم (محمد 95) هذا ولا نريد تكرار هذه الأسماء في هذا الموضع أو غيره نهائيا علما بأن التكرار أيضا نسي (5) الخمسة صفوف الأولى من شيت (معاشات) ويبدأ الترقيم من رقم (6).

4)   لو أمعنا النظر في شيت (DATA) في الخلية (B10) لوجدناها باسم (محمد 128)؛ ولو قمنا بتغيير الرقم القومي الخاص بهذا الاسم ليصبح (26505071500030) بدلا من (26508071500030) ليصبح تاريخ إحالته على المعاش هو (06/05/2025) ثم قمنا بالضغط على زر (ترحيل المحالين على المعاش) الموجود في شيت (DATA) لتم ترحيل الاسم إلى شيت (معاشات) وأصبح في الخلية (B27) وهو بهذا الشكل يصبح في التسلسل التصاعدي الطبيعي له طبقا لتاريخ الإحالة للمعاش وهذا جهدا خالصا للأستاذ / @عبدالله بشير عبدالله الذي لم يدخر جهدا ولم يمل من كثرة تساؤلاتنا حتى وصل بنا لعمل يستحق عليه الشكر والثناء فجزاه الله عنا خير الجزاء؛ وأيضا لتم حذف الاسم من شيت (DATA) ويتم تغيير التسلسل الخاص بالترقيم تلقائيا ولا يتأثر سواء بالحذف أو الإضافة.  

5)   لو عدنا إلى شيت (SEARCH) لوجدنا اسم (محمد 128) قد تم حذفه من خلية (B10) وحل الاسم التالي له في الشيت نفسه مكانه ليصبح (محمد 129) والمفترض أن اسم (محمد 128) يتم إضافته في شيت (SEARCH) ليصبح في الخلية (B7855) ويتم حذف الأسماء المكررة المشار إليها سابقا في الملحوظة رقم (3) ولو ضغطنا على زر (Ref) الخاص بتحديث البيانات في الشيت نفسه لخرجت لنا رسالة تخبرنا بأنه (تم تحديث البيانات بنجاح) علما بأنه لم يتغير من الأمر شيء فالمكرر كما هو والاسم الذي تم حذفه من الشيت لم يأخذ مكانه الآخر والمفترض أن يكون فيه في نفس الشيت.

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

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

[عبدالله بشير عبدالله]

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

الاستاذ الفاضل  algammal

جزاك الله كل خيرا  على  ثتاؤك ودعائك لي 

الاستاذ الفاضل  Foksh

 

تحية لك ولاخواننا في منتدى الاكسس 

بعد اذنكما

ساطرح فكرة اخرى لطلب حبيبنا algammal

حسب فهمى لطلبكم انكم تريدون البحث باسم الموظف او الرقم الوطني  او من  وظيفتهم طبيب كمثال 

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

الفكرة كود يقوم بالبحث في شيت معاشات وشيت data  باستخذام النطاق a5:m5 في شيت search  ونتيجة البحث ينم وضعها في نفس الشيت بداية من A10

تم عمل قائمة بالاسماء بدل كنابنها ويتم تحديثها يدويا  بواسطة زر وتتحدث تلقائيا عتد الانتهاء من البحث

الملف المرفق يوضح الفكرة

 لكما ولكل اعضاء المنتدى وافر التقدير والاخترام

طريقة اخرى للبحث.xlsb

 

تم تعديل بالامس في 12:22 بواسطه عبدالله بشير عبدالله

[Foksh]

بناءً على المطلوب الأخير لك ، ومشاركة مع أستاذنا @عبدالله بشير عبدالله ،،

قمت بحذف الدوال السابقة للبحث ، واستبدلتها بفكرة واحدة بحيث ( لا حاجة فعلاً لتكرار البيانات في الأوراق جميعها ، وقد تم حذف البيانات في الورقة Search ، وستكون دالة البحث ودالة مسح وتنظيف نتائج البحث كالتالي :-

 

Sub SearchAll()
    Dim wsSearch As Worksheet
    Dim wsData As Worksheet
    Dim wsPensions As Worksheet
    Dim searchCol As Long
    Dim searchValue As String
    Dim lastRowData As Long
    Dim lastRowPensions As Long
    Dim resultRow As Long
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Set wsSearch = ThisWorkbook.Sheets("SEARCH")
    Set wsData = ThisWorkbook.Sheets("DATA")
    Set wsPensions = ThisWorkbook.Sheets("معاشات")
    
    wsSearch.Range("A10:M1000").ClearContents
    resultRow = 10
    
    For searchCol = 1 To 13
        If Not IsEmpty(wsSearch.Cells(5, searchCol)) Then
            searchValue = wsSearch.Cells(5, searchCol).Value
            
            lastRowData = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row
            If lastRowData > 4 Then
                With wsData.Range("A5:M" & lastRowData)
                    .AutoFilter
                    .AutoFilter Field:=searchCol, Criteria1:="=" & searchValue, _
                               Operator:=xlAnd
                    On Error Resume Next
                    .Offset(1).SpecialCells(xlCellTypeVisible).Copy
                    wsSearch.Cells(resultRow, 1).PasteSpecial xlPasteValues
                    On Error GoTo 0
                    .AutoFilter
                End With
            End If
            
            resultRow = wsSearch.Cells(wsSearch.Rows.Count, "A").End(xlUp).Row + 1
            If resultRow < 10 Then resultRow = 10
            
            lastRowPensions = wsPensions.Cells(wsPensions.Rows.Count, "A").End(xlUp).Row
            If lastRowPensions > 4 Then
                With wsPensions.Range("A5:M" & lastRowPensions)
                    .AutoFilter
                    .AutoFilter Field:=searchCol, Criteria1:="=" & searchValue, _
                               Operator:=xlAnd
                    On Error Resume Next
                    .Offset(1).SpecialCells(xlCellTypeVisible).Copy
                    wsSearch.Cells(resultRow, 1).PasteSpecial xlPasteValues
                    On Error GoTo 0
                    .AutoFilter
                End With
            End If
            
            Exit For
        End If
    Next searchCol
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.CutCopyMode = False
End Sub

Sub ClearSearch()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("SEARCH")
    
    ws.Range("A10:M1000").ClearContents
    ws.Range("A5:M5").ClearContents
    
    ws.Range("B5").Select
End Sub

 

 

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

[محمد هشام.]

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

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

وتقوم الفكرة على الاستغناء الكامل عن ورقة SEARCH بما في ذلك التصفية التقليدية في النطاق A5:M5 وذلك من خلال استخدام نموذج بحث (UserForm) متكامل مرتبط مباشرة بقاعدة البيانات
هذا النموذج يوفر المزايا التالية:

البحث الفوري والتصفية المباشرة من ورقة DATA باستخدام قوائم منسدلة ComboBoxes ديناميكية 

إمكانية ترحيل النتائج إلى ورقة أخرى SEARCH عند الحاجة لذلك 

واجهة مرنة قابلة للتطوير تغني تماما عن الحاجة إلى أوراق وسيطة مما يجعل العمل أكثر تنظيما وسلاسة

عرض عدد النتائج بعد التصفية بشكل تلقائي 

يشرفني أن أشارك هذه الفكرة المتواضعة في سبيل إثراء هذا العمل المميز وآمل أن تشكل إضافة مفيدة ضمن هذا الجهد الرائع

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

مع خالص التقدير والاحترام للجميع

 

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

تم تعديل بالامس في 12:29 بواسطه محمد هشام.
خطأ إملائي

[Foksh]

لوجود خطأ في نتائج البحث بعد التجربة ، قمت بالتعديل التالي على دالة البحث الرئيسية على سبيل المثال :-

Sub SearchAll()
    Dim wsSearch As Worksheet
    Dim wsData As Worksheet
    Dim wsPensions As Worksheet
    Dim searchCol As Long
    Dim searchValue As String
    Dim resultRow As Long
    Dim visibleRange As Range
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Set wsSearch = ThisWorkbook.Sheets("Search")
    Set wsData = ThisWorkbook.Sheets("Data")
    Set wsPensions = ThisWorkbook.Sheets("معاشات")
    
    wsSearch.Range("A10:M1000").ClearContents
    resultRow = 10
    
    For searchCol = 1 To 13
        If Not IsEmpty(wsSearch.Cells(5, searchCol)) Then
            searchValue = Application.Clean(Trim(wsSearch.Cells(5, searchCol).Text))
            
            With wsData
                .AutoFilterMode = False
                .Range("A4:M" & .Rows.Count).AutoFilter Field:=searchCol, Criteria1:=searchValue
                On Error Resume Next
                Set visibleRange = .AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible)
                If Not visibleRange Is Nothing Then
                    visibleRange.Copy
                    wsSearch.Cells(resultRow, 1).PasteSpecial xlPasteValues
                    resultRow = resultRow + visibleRange.Rows.Count
                End If
                On Error GoTo 0
                .AutoFilterMode = False
            End With
            
            With wsPensions
                .AutoFilterMode = False
                .Range("A4:M" & .Rows.Count).AutoFilter Field:=searchCol, Criteria1:=searchValue
                On Error Resume Next
                Set visibleRange = .AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible)
                If Not visibleRange Is Nothing Then
                    visibleRange.Copy
                    wsSearch.Cells(resultRow, 1).PasteSpecial xlPasteValues
                    resultRow = resultRow + visibleRange.Rows.Count
                End If
                On Error GoTo 0
                .AutoFilterMode = False
            End With
            
            Exit For
        End If
    Next searchCol
    
    Application.Calculation = xlCalculationAutomatic
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

 

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

[algammal]

أخي الكريم الأستاذ / @عبدالله بشير عبدالله

أخي الكريم الأستاذ / @محمد هشام.

أخي الكريم الأستاذ / @Foksh

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

أطال الله فى أعماركم وحسن أعمالكم وجعل الله لكم بركة فى العمر وسعة فى الرزق وصحة وسلامة فى البدن وأسعدكم الله فى الدارين وجعلكم الله سنداً وفخرا لنا دوما وحفظكم الله من كل مكروه وسوء؛ وأنار الله قلبكم بالعلم والدين؛ وشرح صدركم بالهدى واليقين؛ ويسر أموركم ورفع مقامكم في عليين؛ وحشركم الله بجوار النبي الأمين. اللهم آمين رب العالمين.

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

 

أخي الكريم الفاضل الأستاذ / @Foksh

جزاكم الله كل الخير على ماقدمتموه أحسنتم وأحسن الله إليكم ولا حرمنا الله من علمكم آمين رب العالمين؛ وحفظكم الله من كل مكروه وسوء. آمين رب العالمين.

 

أخي الكريم الفاضل الأستاذ / @محمد هشام.

في 26‏/5‏/2025 at 02:15, محمد هشام. said:

هذا النموذج يوفر المزايا التالية:

البحث الفوري والتصفية المباشرة من ورقة DATA باستخدام قوائم منسدلة ComboBoxes ديناميكية 

(UserForm1) فوق الممتاز سلمت وسلمت يمينك وحفظك الله من كل مكروه وسوء؛ وإني لأرجو أخي الكريم أن يأخذ البحث الفوري والتصفية المباشرة في الحسبان ورقة (معاشات) بالإضافة إلى ورقة (DATA) وجزاكم الله الخير كله.

أخي الكريم الفاضل الأستاذ / @عبدالله بشير عبدالله

سلمت وسلمت يمينك وحفظك الله من كل مكروه وسوء آمين رب العالمين.

أطمع في فيض علمكم ورحابة وسعة صدركم وعظيم حلمكم وكرم أخلاقكم الذي شجعنا على ألا نخجل من سؤالكم أبدا وكيف لا وأنتم من شجعتونا سابقا على ذلك بقولكم لنا دوما:

·       جرب الملف واعلمنى بالنتائج.

·       وأي ملاحظات أذكرها وإن شاء الله وبعونه نقوم بالواجب.

·       أتمنى أن تجد طلبك في الملف ولا حرج في أي ملاحظات تراها تخدم العمل في ملفك.

·       وإن أردت أي تعديل في الملف فأبشر.

·       جرب الملف وإن هناك شئ لم يحقق ما طلبت فأوضح ثم أبشر. 

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

ومن هذا المنطلق أخي الكريم أرجو مساعدتكم بشأن ما يلي في الملف المرفق (والذي تم عليه تعديل طفيف):  

1)   إزالة القائمة المنسدلة من (B5) والتي تختص بالأسماء.

2)   عمل قائمة منسدلة في (C5) تختص بالدرجة وتشمل: (الأولى؛ الثانية؛ الثالثة؛ الرابعة؛ الخامسة؛ السادسة؛ مدير عام؛ العالية).

3)   ترك القائمة المنسدلة في (E5) والتي تختص بالوظيفة كما هي.

4)   عمل قائمة منسدلة في (F5) تختص بالنوع (ذكر؛ أنثى).

5)   عمل قائمة منسدلة في (J5) تختص بسن الخروج وتشمل: (60؛ 61؛ 62؛ 63؛ 64؛ 65).

6)    عمل قائمة منسدلة في (B9) تشمل: كل المهن الموجودة في (B5) بالإضافة لكلمة (معاش).

7)   أريد فكرة سريعة عما يفعله زر (تحديث البيانات) في شيت (SEARCH) واسم الماكرو المرتبط به.

وجزاكم الله الخير كله. آمين رب العالمين.

 

طريقة اخرى للبحث معدلة.xlsb

[عبدالله بشير عبدالله]

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

الاستاذ الفاضل algammal

بداية من اخر استفسار لكم

11 ساعات مضت, algammal said:

أريد فكرة سريعة عما يفعله زر (تحديث البيانات) في شيت (SEARCH) واسم الماكرو المرتبط به.

هذا الزر غير ضرورى قمت بعمله بداية ثم نسيت ان احذفه

بالتسبة للقوائم المتسدلة جعلتها مرنه بحيث يتم احضار  البياتات  الفعلية من العمود فقط فمثلا حاليا سن الخروج كلها 60 ستجد في القائمة 60 فقط واذا اضفت مثلا اي سن خروج اخرى في شيت معاشات او DATA ستجدها في القائمة وكذلك لباقى القوائم الاخرى لها تفس الخاصية

11 ساعات مضت, algammal said:

6)    عمل قائمة منسدلة في (B9) تشمل: كل المهن الموجودة في (B5) بالإضافة لكلمة (معاش).

 

اعتقد تقصد كل المهن الموجودة في الخلية E5 وليس B5

هذا حسب فهمى لطلبكم   وفي اتنظار ملاحظايكم 

كما احب ان اتوه فكرة الاستاذ @محمد هشام. رائعة جدا وتحتاج الى تعديل في الكود لكي يتم البحث في شيت معاشات اظافة الى شيت DATA لان البياتات في شيت معاشات  تم ترحيلها من شيت DATA  الى  معاشات وتم حذفها من شيت DATA بعد الترحيل

في اتنظار تعديل الكود وفقه الله وجزاه الله خيرا

لكم جميعا اطيب التحيات

 

 

طريقة اخرى للبحث معدلة1.xlsb

تم تعديل منذ 8 ساعات بواسطه عبدالله بشير عبدالله

[algammal]

أخونا وحبيبنا الكريم معالي الأستاذ / @عبدالله بشير عبدالله

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

13 ساعات مضت, عبدالله بشير عبدالله said:

اعتقد تقصد كل المهن الموجودة في الخلية E5 وليس B5

نعم أستاذنا الفاضل اعتقادكم صحيح 100% وأعتذر عن الخطأ؛ فإن أخطأ التلميذ فالأستاذ يقظ ما شاء الله تبارك الله وهذا ما عهدناه فيكم من خلال تلك الفترة الوجيزة؛ بل ما شاء الله تبارك الله تقرؤون ما بين السطور جيدا وتعلمون المطلوب بالضبط وتضعون يدكم عليه بمهارة فائقة وفقكم الله لكل خير وجزاكم الله عنا خير الجزاء.

13 ساعات مضت, عبدالله بشير عبدالله said:

كما احب ان اتوه فكرة الاستاذ @محمد هشام. رائعة جدا وتحتاج الى تعديل في الكود لكي يتم البحث في شيت معاشات اظافة الى شيت DATA لان البياتات في شيت معاشات  تم ترحيلها من شيت DATA  الى  معاشات وتم حذفها من شيت DATA بعد الترحيل

في اتنظار تعديل الكود وفقه الله وجزاه الله خيرا

 

نعم أخونا وحبيبنا الأستاذ الفاضل / @عبدالله بشير عبدالله

لقد أوجزت ولخصت وبينت المطلوب تماما من أخينا وحبيبنا الأستاذ الفاضل / @محمد هشام. له منا ولكم كل احترام وتقدير؛ وكيف لا وأنتم تعلمون خبايا ودهاليز الملف لأنه صنع على يديكم فأهل مكة أدرى بشعابها.

 أخونا وحبيبنا الأستاذ المحترم / @عبدالله بشير عبدالله

لو أمكن مساعدتنا فيما يلي:

1)   عمل قائمة منسدلة في (G5) تختص بمحافظة الميلاد: (القاهرة؛ الإسكندرية؛ بورسعيد؛ السويس؛ دمياط؛ الدقهلية؛ الشرقية؛ القليوبية؛ كفر الشيخ؛ الغربية؛ المنوفية؛ البحيرة؛ الإسماعيلية؛ الجيزة؛ بني سويف؛ الفيوم؛ المنيا؛ أسيوط؛ سوهاج؛ قنا؛ أسوان؛ الأقصر؛ البحر الأحمر؛ الوادي الجديد؛ مطروح؛ شمال سيناء؛ جنوب سيناء؛ خارج الجمورية) وهي موجودة في شيت (كود محافظة الميلاد).

2)   عمل قائمة منسدلة في (H5) و (K5) تختص بأسماء الأسبوع (السبت؛ الأحد؛ الاثنين؛ الثلاثاء؛ الأربعاء؛ الخميس؛ الجمعة).

3)   عمل قائمة منسدلة في (M5) تختص بملاحظات: تحتوي على كلمة (معاش) لحين إضافة كلمات أخرى لاحقا.

4)   بالنسبة للخلية (A5) قبل التعديل الأخير كان البحث فيها عن أي رقم متاح؛ وبعد آخر تعديل لم يعد متاحا؛ لو أمكن أن تعود سيرتها الأولى؛ وأكون لكم من الشاكرين.

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