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

Sub filter_for_ME()

    With Application

     .ScreenUpdating = False

     .Calculation = xlCalculationManual

    End With

Dim S_sh As Worksheet: Set S_sh = Sheets("Sheet1")

Dim T_sh As Worksheet: Set T_sh = Sheets("Sheet2")

Dim My_Table As Range: Set My_Table = S_sh.Range("A1").CurrentRegion



T_sh.Range("a10").CurrentRegion.ClearContents

T_sh.Range("q2").Formula = "=Sheet1!A2=$B$3"



My_Table.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=T_sh.Range("Q1:q2"), _

CopyToRange:=T_sh.Range("A10:C10")

T_sh.Range("q2").ClearContents

    With Application

     .ScreenUpdating = True

     .Calculation = xlCalculationAutomatic

    End With

End Sub

الملف مرفق

المشاركة الأصلية كتبت بواسطة: هانى على

أحسنت استاذ عماد وجزاك الله كل خير

المشاركة الأصلية كتبت بواسطة: عبدالجيد

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

المشاركة الأصلية كتبت بواسطة: salim

بارك الله بك استاذ عماد

عندي ملاحظة بالنسبة Dim أرجو تقبلها

​عند اعلان المتغيرات بصيغة 
dim lr,p,x as long

فان اكسل يأخذ اخر متغير بشكل long والباقيين يشكل Variant

​يمكن التحقق من ذلك بواسطة Local Window

 لذا يجب الكتابة بهذا الشكل Dim lr as long,x as long ,p as long

زيادة في اثراء الموضوع هذا الكود

Sub filter_for_ME()

    With Application

     .ScreenUpdating = False

     .Calculation = xlCalculationManual

    End With

Dim S_sh As Worksheet: Set S_sh = Sheets("Sheet1")

Dim T_sh As Worksheet: Set T_sh = Sheets("Sheet2")

Dim My_Table As Range: Set My_Table = S_sh.Range("A1").CurrentRegion



T_sh.Range("a10").CurrentRegion.ClearContents

T_sh.Range("q2").Formula = "=Sheet1!A2=$B$3"



My_Table.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=T_sh.Range("Q1:q2"), _

CopyToRange:=T_sh.Range("A10:C10")

T_sh.Range("q2").ClearContents

    With Application

     .ScreenUpdating = True

     .Calculation = xlCalculationAutomatic

    End With

End Sub

الملف مرفق

المشاركة الأصلية كتبت بواسطة: ali mohamed ali

وعليكم السلام عودا حميدا استاذ عماد بارك الله فيك -ولعل غيابك وانقطاعك يكون خيرا
كل عام وانتم بخير -عمل رائع وكود ممتاز جعله الله فى ميزان حسناتك

المشاركة الأصلية كتبت بواسطة: emad ghazi

المشاركة الأصلية كتبت بواسطة: salim

بارك الله بك استاذ عماد

عندي ملاحظة بالنسبة Dim أرجو تقبلها

​عند اعلان المتغيرات بصيغة 
dim lr,p,x as long

فان اكسل يأخذ اخر متغير بشكل long والباقيين يشكل Variant

​يمكن التحقق من ذلك بواسطة Local Window

 لذا يجب الكتابة بهذا الشكل Dim lr as long,x as long ,p as long

زيادة في اثراء الموضوع هذا الكود

Sub filter_for_ME()

    With Application

     .ScreenUpdating = False

     .Calculation = xlCalculationManual

    End With

Dim S_sh As Worksheet: Set S_sh = Sheets("Sheet1")

Dim T_sh As Worksheet: Set T_sh = Sheets("Sheet2")

Dim My_Table As Range: Set My_Table = S_sh.Range("A1").CurrentRegion



T_sh.Range("a10").CurrentRegion.ClearContents

T_sh.Range("q2").Formula = "=Sheet1!A2=$B$3"



My_Table.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=T_sh.Range("Q1:q2"), _

CopyToRange:=T_sh.Range("A10:C10")

T_sh.Range("q2").ClearContents

    With Application

     .ScreenUpdating = True

     .Calculation = xlCalculationAutomatic

    End With

End Sub

الملف مرفق

جزاك الله خير استاذى ملاحظة ممتازة وكود ممتا ز
انا تلميذ لكل واحد صاحب علم 
احنا هنا نتعلم من بعض
 

المشاركة الأصلية كتبت بواسطة: salim

بارك الله بك استاذ عماد

عندي ملاحظة بالنسبة Dim أرجو تقبلها

​عند اعلان المتغيرات بصيغة 
dim lr,p,x as long

فان اكسل يأخذ اخر متغير بشكل long والباقيين يشكل Variant

​يمكن التحقق من ذلك بواسطة Local Window

 لذا يجب الكتابة بهذا الشكل Dim lr as long,x as long ,p as long

زيادة في اثراء الموضوع هذا الكود

Sub filter_for_ME()

    With Application

     .ScreenUpdating = False

     .Calculation = xlCalculationManual

    End With

Dim S_sh As Worksheet: Set S_sh = Sheets("Sheet1")

Dim T_sh As Worksheet: Set T_sh = Sheets("Sheet2")

Dim My_Table As Range: Set My_Table = S_sh.Range("A1").CurrentRegion



T_sh.Range("a10").CurrentRegion.ClearContents

T_sh.Range("q2").Formula = "=Sheet1!A2=$B$3"



My_Table.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=T_sh.Range("Q1:q2"), _

CopyToRange:=T_sh.Range("A10:C10")

T_sh.Range("q2").ClearContents

    With Application

     .ScreenUpdating = True

     .Calculation = xlCalculationAutomatic

    End With

End Sub

الملف مرفق