كود بحث سريع جدا

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



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

الكود يقوم بالبحث داخل الشيت 1 عن القيمة المدخلة في خلية البحث بالشيت 2

ويتم عرض النتائج داخل الشيت 2 بالعمود A

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

 Sub Yasser_Serch()  
   Dim xx, zz, targt  
   Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row + 1).ClearContents  
   targt = Range("C2").Text  
   xx = Sheet1.Range("A1:A" & Sheet1.Cells(Rows.Count, 1).End(xlUp).Row).Value  
   ReDim Y(1 To Sheet1.Range("A1:A" & Sheet1.Cells(Rows.Count, 1).End(xlUp).Row).Count ^ 2, 1 To 1)  
   For Each zz In xx  
     If targt = "" Then Exit Sub  
     If zz Like targt & "*" Then  
       rw = rw + 1  
       Y(rw, 1) = zz  
     End If  
   Next zz  
   If rw > 0 Then Sheet2.Cells(Rows.Count, 1).End(xlUp)(2, 1).Resize(rw, 1).Value = Y()  
 End Sub  

وفي حدث تغيير الشيت يتم تشغيل الكود كما موضح

 Private Sub Worksheet_Change(ByVal Target As Range)  
   If Target.Address = "$C$2" Then  
     Call Yasser_Serch  
   End If  
 End Sub  


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


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




الإبتساماتإخفاء