Filter By_Selection

[سليم حاصبيا]

أمامنا جدول مع بيانات مختلفة
1- انقر على اي خلية من الجدول (ما عدا رأس الجدول) لتحصل على فلتر بقيمة هذه الخلية
2-انقر على اي خلية ( من رأس الجدول) لتحصل على كل البيانات
3-لإضافة بيانات على الجدول انقر على اول صف فارغ  وأملأ الصف كما تشاء (لا يعمل الماكرو الا اذا كان الصف
    كاملاً ببياناته 4 قيم)
ملاحظة: لا يعمل الماكرو Reset ولا الماكرو Make_On_Top  كل بمفرده  الا من خلال الماكرو الرئيسي SelectionChange
الماكرو

 Option Explicit
 Dim Lr%, Rng As Range
 '==========================
Sub Make_On_Top()
On Error GoTo Exit_Sub
Rng.Rows(1).Interior.ColorIndex = 6
    With ActiveSheet
      .Range("z1") = Cells(3, ActiveCell.Column)
      .Range("z2") = ActiveCell.Value
      .Range("a3").CurrentRegion.AdvancedFilter 1, Range("z1:z2")
      .Cells(3, ActiveCell.Column).Interior.ColorIndex = 8
    End With
Exit_Sub:
End Sub
'==================================
Sub Reset()
On Error GoTo Exit_Sub
 Rng.Rows(1).Interior.ColorIndex = 6
    On Error Resume Next
        ActiveSheet.ShowAllData
    On Error GoTo 0
Exit_Sub:
End Sub
'===========================
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Lr = Cells(Rows.Count, 1).End(3).Row
  Set Rng = Range("A3:D" & Lr)
If Not Intersect(Target, Rng) Is Nothing And _
      Application.CountA(Range(Cells(Target.Row, 1), _
      Cells(Target.Row, 4))) = 4 _
      And Target.Cells.Count = 1 Then
       
    If Target.Row = 3 Then
        Reset
    Else
        Make_On_Top
    End If
    
End If
 Range("z1:z2").Clear
End Sub

الملف مرفق

Super Adv_Filter.xlsm

[Ali Mohamed Ali]

عمل رائع استاذ سليم بارك الله فيك وجعله فى ميزان حسناتك

[saad alyousif]

نموذج رائعععععععع بارك الله فيك

[على متولى]

السلام عليكم ورحمة الله وبركاته
كفــــارة المجــلس
سبحانك اللهم وبحمدك ، أشهــد أن لا إله إلا أنت أستغفرك وأتوب إليك
جزاكم الله خيرا
وجعل كل ايامكم رضا
والسلام عليكم ورحمة الله وبركاته

[nassimerouh]

شكرا استاذ سليم على هذا العمل الرائع

اود تطبيق هذا الماكرو على هذا النموذج المرفق لو تفضلتم بمساعدتي على ذلك

 

Book3.xlsx

تم تعديل سبتمبر 23, 2018 بواسطه nassimerouh

[سليم حاصبيا]

الملف جاهز

أهم شيء الا يكون داخل الجدول اي خلية فارغة

 و كذلك في راس الجدول

 

 

Salim_book.xlsm