بحث متقدم - سرعة عالية ومرونة باستخدام المصفوفات

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

بحث متقدم

كود بحث متقدم  يفوق معظم أنواع  البحث بالاعتماد على المصفوفات 

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

والمرونة العالية به  من حيث البحث داخل كل الأعمدة الموجودة داخل النطاق 

تم توضيح المتغيرات التي تستطيعوا تعديلها لتتوافق مع ملفاتكم 

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

 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  

لتحميل الملف اضغط هنا

تم عمل اضافة بسيطة للبحث بشرطين اي شرط مع شرط التاريخ

صورة توضيحية لشكل البحث

 
لتحميل الملف اضغط هنا

اعداد /  ياسر العربي

شارك المقال

شاركه على فيسبوكشاركه على جوجل+