أبو العاصم قام بنشر أكتوبر 1, 2010 قام بنشر أكتوبر 1, 2010 السلام عليكم ورحمة الله وبركاته إخوتى فى الله عندى الكود التالى وأود إضافة عنصران للتصفية الجزئية علية وأرفقت ملف به مثال للمطلوب وبه خلايا فارغة حتى اذا عجزت عن فهم الكود لصقته فى ملف العمل الخاص بى بدون متاعب بارك الله فيكم Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$j$12" Then Range("j16:q100").AutoFilter Field:=7, Criteria1:=Target.Value End If End Sub good.rar
الحسامي قام بنشر أكتوبر 2, 2010 قام بنشر أكتوبر 2, 2010 السلام عليكم اخي الكريم شاهد المرفق التالي فقد يكون طلبك good.rar
أبو العاصم قام بنشر أكتوبر 3, 2010 الكاتب قام بنشر أكتوبر 3, 2010 أخى الحسامى عملك عين المطلوب لكن جزاك الله خيرا لو تفضلت علينا بشرح الكود الخاص بالفلترة جزاك الله خيرا Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("j12")) Is Nothing Then '------------------------- Application.ScreenUpdating = False ActiveSheet.Range("$A$15:$Q$52").AutoFilter Field:=15 ActiveSheet.Range("$A$15:$Q$52").AutoFilter Field:=16 ActiveSheet.Range("$A$15:$Q$52").AutoFilter Field:=17 Range("j16:q100").AutoFilter Field:=16, Criteria1:=Range("j12").Value End If If Not Intersect(Target, Range("j13")) Is Nothing Then '------------------------- Application.ScreenUpdating = False Range("j16:q100").AutoFilter Field:=15, Criteria1:=Range("j13").Value End If If Not Intersect(Target, Range("K14")) Is Nothing Then '------------------------- Application.ScreenUpdating = False Range("j16:q100").AutoFilter Field:=17, Criteria1:=Range("K14").Value End If End Sub
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.