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

[ياسر العربى]

بسم الله الرحمن الرحيم
 

 

اليوم اقدم لكم بحث متقدم للبحث عن الاسم بالحرف او الكلمة او الجملة
 

وعرض النتائج في كمبوبوكس والليست بوكس

 

وايضا تم اضافة امكانية تحديد الاسم من الليست بوكس 

 

وعمل شيت بنفس الاسم المحدد داخل اللسيت

 

كما يمكنك ايضا من الذهاب الى شيت  الاسم المحدد داخل الليست بوكس
 

 

الكود المستخدم داخل الملف

 

كود البحث

Private Sub ComboBox1_Change()
    Dim a()
    Dim b, c, d, e
    Dim Ws As Worksheet: Set Ws = Sheets("Sheet1")
    Dim l As MSForms.ComboBox: Set l = Me.ComboBox1
    Dim i As Long: i = 0

    e = Ws.Range("a40000").End(xlUp).Row
    a = Ws.Range("A2:a" & e).Value
    With Me.ComboBox1
        .List = a
        .ListRows = 20
        .MatchEntry = fmMatchEntryNone
        .TextAlign = fmTextAlignCenter
    End With
    Set b = CreateObject("Scripting.Dictionary")
    d = "*" & UCase(Me.ComboBox1) & "*"
    For Each c In a
        If UCase(c) Like d Then b(c) = ""
    Next c
    Me.ComboBox1.List = b.keys
    While i < l.ListCount
        If "" = Trim$(l.List(i, 0)) Then: l.RemoveItem (i): Else i = 1 + i
    Wend
    ListBox1.AddItem
    ListBox1.List = ComboBox1.List
End Sub

 

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

 

Private Sub CommandButton1_Click()
    Dim Ws As Worksheet
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    On Error Resume Next
    Set Ws = Worksheets(CStr(ListBox1.Text))
    On Error GoTo 0
    If Ws Is Nothing Then
        Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = CStr(ListBox1.Text)
        Sheet1.Activate
        Set Ws = Nothing
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

 

كود الذهاب الى شيت الاسم المختار
 

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Dim Ws As Worksheet
    On Error Resume Next
    Set Ws = Worksheets(CStr(ListBox1.Value))
    Ws.Activate
    Set Ws = Nothing
End Sub

لتحمل البرنامج اضغط هنا


تقبلو تحياتي

ياسر العربي

[محمد حسن المحمد]

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

جزاكم الله خيراً على هذا التطوير الرائع للبحث المتقدم ...وإلى المزيد من الأعمال المتقنة..بارك الله بكم 

والسلام عليكم.

[عبد العزيز البسكري]

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

أخي الغالي " ياسر العربي"

إبداع رائع و متميّز حول البحث المتقدّم يُضاف لقائمة إبداعاتك

بارك الله فيك و لك و جزاك خير الجزاء و زادك من علمه و فضله

فائق إعجاباتي

 

 

[ياسر العربى]

51 دقائق مضت, محمد حسن المحمد said:

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

 

31 دقائق مضت, عبد العزيز البسكري said:

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

كل الشكر وا لتقدير لكم احبائي

ابو يوسف

عبدالعزيز البسكري

تقبلوا فائق احترامي وتقديري

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

أخي الغالي ياسر العربي

لكم نفقتد موضوعاتك المتميزة في المنتدى .. جزيت خير الجزاء على هذا الموضوع الرائع والمفيد جداً

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

تقبل تحياتي

[ياسر العربى]

7 ساعات مضت, ياسر خليل أبو البراء said:

أخي الغالي ياسر العربي

لكم نفقتد موضوعاتك المتميزة في المنتدى .. جزيت خير الجزاء على هذا الموضوع الرائع والمفيد جداً

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

تقبل تحياتي

لكم نفتقد ايامنا المتميزة التي جمعتنا بكم بالمنتدى

جزيت خيرا اخي الكريم  ابو البراء

تقبل فائق احترامي

[saad abed]

اخى ياسر

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

[ياسر العربى]

39 دقائق مضت, سعد عابد said:

اخى ياسر

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

اخي الكريم سعد

تقبل فائق احترامي

لمروركم الكريم

 

[محي الدين ابو البشر]

السلام عليكم

واسعد الله صباحكم 

ويوم مبارك بإذن اللع تعالى

استاذ ياسر العربي

تعجز الكلمات 

بارك الله بك زجزاك كل خير وسر خاطرك

وجعلها في ميزان حسناتك

[ياسر العربى]

كل الشكر والتقدير لشخصكم الكريم اخي الغالي محي الدين

تقبل فائق احترامي

 

[جلال الجمال_ابو أدهم]

ما شاء الله
تحياتى