البحث في الموقع

السلام عليكم ورحمة الله تعالى وبركاته هذا المرفق نزولا على رغبة اخ كريم Filter Utility.accdb

أرفق اليكم نموذج بحث متعدد النتائج .. به وحدة نمطية بسيطة لتوحديد الأحرف المتشابهة وإزالة المسافات وتجاهل الهمزات والتشكيل ..عسى يجد من ينتفع به.وتجدر الإشارة أن أغلبه من أفكار رواد هذا المنتدى العزيز. أعزكم الله .. تحياتى Officna.rar

السلام عليكم ورحمة الله تعالى وبركاته المثال المرفق خاص بالبحث والتظليل طبعا تقدمت قبل ذلك بمثل هذا الموضوع ولكن للامانه اشرت اننى نقلت من مثال من موقع اجنبى بمساعد الاستاذ يوسف جزاه الله خيرا عندمى دلنى عليه ولكن انا قمت بالتعديل عليه لعمل فلتر تلقائى للحروف والكلمات التى تطابق التى تم كتابتها فى مربع النص الخاص بالبحث ولكن للامانه ايضا اكتشفت خللا نتيجة ذلك التعديل الذى قمت به ولم اكتشفه الا مع التجربة ومحاولة نقل النموذج من قاعدة لاخرى والان ارفق هذا المثال الاجنبى الاصلى فقط قمت بالتعديل على الفورم وطريقة عرض الحقول المطلوب من اساتذتى الكرام جزاهم الله عنا كل الخير مثلا انا لو اخترت البحث عن ContactName لو كتبت فر مربع نص البحث اوفيس ثم قمت بالضغط على مفتاح الـ Enter من لوحة المفاتيح يتم البحث والفرز واظهار النتائج المطابقة فقط كما فى الصورة التالية انا اريد ان يتم البحث والفرز تلقائيا اثناء كتابة احرف البحث داخل مربع البحث دون الضغط على مفتاح الـ Enter SearchHighlight.rar

تم رفع هذا الكود فى مشاركة منفصله حتى لا ننسى هذه المشاركة بحث متقدم - سرعة عالية ومرونة باستخدام المصفوفات تم ارفاق المشاركه من الفاضل _ أ / ياسر العربى اولا _ البحث بالاسم الاول و بشروط SERCH_ARRY_YASSER_ELARABY1 (2).rar ثانيا _ البحث بالاسم الشامل و بشروط SERCH_ARRY_YASSER_ELARABY1_بحث شامل بالاسم و بشروط.rar ثالثا_ البحث بالاسم الاول و بشروط بالفورم و الليست listbox.rar و لا تنسونا من صالح الدعاء

بسم الله الرحمن الرحيم اقدم لكم كود بحث متقدم كود بحث متقدم يفوق معظم أنواع البحث بالاعتماد على المصفوفات لضمان كفاءة عالية للبحث وسرعة جلب البيانات والمرونة العالية به من حيث البحث داخل كل الأعمدة الموجودة داخل النطاق تم توضيح المتغيرات التي تستطيعوا تعديلها لتتوافق مع ملفاتكم الكود المستخدم داخل الملف Sub Yasser_Serch() Dim myArray, lr, X, targt, targtN Dim SERCH As Worksheet, DATA As Worksheet '____________________________________________ Set DATA = Worksheets("Sheet2") 'اسم شيت قاعدة البيانات Set SERCH = Worksheets("Sheet1") 'اسم الشيت الخاص بالبحث '____________________________________________ lr = DATA.Cells(Rows.Count, 1).End(xlUp).Row 'اخر صف به بيانات SERCH.Range("A4:J" & SERCH.Cells(Rows.Count, 4).End(xlUp).Row + 1).ClearContents 'مسح نطاق البحث القديم targt = SERCH.Range("e1").Value 'خلية البحث targtN = Application.WorksheetFunction.Match(SERCH.Range("D1"), SERCH.Range("A3:J3"), 0) 'دالة لايجاد رقم عمود البحث myArray = DATA.Range("A2:J" & lr + 1) 'نطاق قاعدةالبيانات الذي سيتم البحث فيه '____________________________________________ ReDim Y(1 To lr, 1 To 10) For X = 1 To lr If targt = "" Then Exit Sub If myArray(X, targtN) Like targt & "*" Then rw = rw + 1 Y(rw, 1) = myArray(X, 1): Y(rw, 6) = myArray(X, 6) Y(rw, 2) = myArray(X, 2): Y(rw, 7) = myArray(X, 7) Y(rw, 3) = myArray(X, 3): Y(rw, 8) = myArray(X, 8) Y(rw, 4) = myArray(X, 4): Y(rw, 9) = myArray(X, 9) Y(rw, 5) = myArray(X, 5): Y(rw, 10) = myArray(X, 10) End If Next X If rw > 0 Then SERCH.Cells(Rows.Count, 1).End(xlUp)(2, 1).Resize(rw, 10).Value = Y() End Sub لتحميل الملف اضغط هنا اعداد / ياسر العربي تقبلو تحياتي

السلام عليكم ورحمة الله وبركاتة ارجوا المساعدة اذا امكن ولكم كل الشكر والتقدير التعديل على الملف المرفق حيث يقوم بالبحث بين تاريخين واظهار الاسم واللقب SERCH_ARRY salim.rar

بسم الله الرحمن الرحيم اليوم اقدم لكم بحث متقدم للبحث عن الاسم بالحرف او الكلمة او الجملة وعرض النتائج في كمبوبوكس والليست بوكس وايضا تم اضافة امكانية تحديد الاسم من الليست بوكس وعمل شيت بنفس الاسم المحدد داخل اللسيت كما يمكنك ايضا من الذهاب الى شيت الاسم المحدد داخل الليست بوكس الكود المستخدم داخل الملف كود البحث 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 لتحمل البرنامج اضغط هنا تقبلو تحياتي ياسر العربي

الاخوه الاعزاء .. ارجوا مساعدتى فى الملف المرفق وهو عمل بحث متقدم فى بيانات العاملين يانات العاملين.rar