كود إلغاء التصفية بشرط؟

[عبدالعزيز محمد]

المطلوب

عندما يكون TextBox = فراغ أي لا يوجد به شيء يتم إلغاء التصفية

لأن عند الكتابة بـTextBox  يتم التصفية بناء على ما تم كتابته فيTextBox

 

Aziz.xlsx

[محمد هشام.]

الملف خالي من الاكواد  مع عدم دكر عمود او معيار الفلترة 

لنفترض انك تريد فلترة البيانات بعمود عدد الابناء اي العمود رقم 3 مثلا 

Option Compare Text
Private Sub TextBox1_Change()
   [A2].AutoFilter field:=3, Criteria1:=Me.TextBox1 & "*"
End Sub

يمكنك نعديل عمود الفلترة على حسب متطلباتك 

 

test_aziz.xlsb

تم تعديل أكتوبر 8, 2023 بواسطه محمد هشام.

[عبدالعزيز محمد]

اشكرك وجزاك الله كل خير

التصفية حسب -اسم الاب ثلاثي-

المطلوب هو كالتالي:عند الكتابة في التكست تتم التصفية وتظهر اداة التصفية في الصف الاول-كما في الصورة المرفقة في المربع الاحمر- وعندما يكون التكست فارغا تختفي اداة التصفية كما هو موضح بالصورة المرفقة-كما في الصورة المرفقة في المربع الاحمر-

[a.kawkab]

السلام عليكم  اخى عبد العزيز تفضل تم المطلوب

Option Compare Text
Private Sub TextBox1_Change()
   [A2].AutoFilter field:=2, Criteria1:=Me.TextBox1 & "*"
   If TextBox1.Value = "" Then [A2].AutoFilter

End Sub

 

A_aziz.xlsb

[محمد هشام.]

ممكن وضع الكود بهدا الشكل لتستطيع الفلترة باي جزء من الاسم

 

Private Sub TextBox1_Change()
Dim WS As Worksheet: Set WS = Sheet1
Set Tbl = WS.ListObjects(1)
 
 Réf = "*" & Replace(Me.TextBox1, " ", "*") & "*"
 Tbl.Range.AutoFilter Field:=2, Criteria1:=Réf
 
 If Me.TextBox1 = Empty Then Tbl.ShowAutoFilter = False

End Sub

 

 

تم تعديل أكتوبر 9, 2023 بواسطه محمد هشام.

[محمد هشام.]

اليك حل اخر باستخدام  Combobox   اظافة الى الحل الاول يمكنك اختيار ما يناسبك

 

Private Sub ComboBox1_GotFocus()
Dim wsdata As Worksheet: Set wsdata = Sheet1
Set d = CreateObject("Scripting.Dictionary")
  For Each c In wsdata.Range("B3", wsdata.Cells(Rows.Count, "B").End(xlUp))
    If Not d.Exists(c.Value) Then d(c.Value) = ""
  Next c
  MyRng = d.keys
  tri MyRng, LBound(MyRng), UBound(MyRng)
 Me.ComboBox1.List = MyRng
End Sub
'***************************************
Private Sub ComboBox1_Change()
Dim WS As Worksheet: Set WS = Sheet1
Set Tbl = WS.ListObjects("Data")
Réf = ComboBox1
Tbl.Range.AutoFilter Field:=2, Criteria1:=Réf
 If Me.ComboBox1 = Empty Then Tbl.ShowAutoFilter = False
End Sub

وفي موديول 

Sub tri(a, gauc, droi)  'ترتيب ابجدي
  Réf = a((gauc + droi) \ 2)
  g = gauc: d = droi
  Do
    Do While a(g) < Réf: g = g + 1: Loop
    Do While Réf < a(d): d = d - 1: Loop
    If g <= d Then
      MyRng = a(g): a(g) = a(d): a(d) = MyRng
      g = g + 1: d = d - 1
    End If
  Loop While g <= d
  If g < droi Then Call tri(a, g, droi)
  If gauc < d Then Call tri(a, gauc, d)
End Sub
'********* ' الغاء الفلترة
Public Sub Reset_filter()
Dim WS As Worksheet: Set WS = Sheet1
Sheets("Sheet1").TextBox1.Text = "": Sheets("Sheet1").ComboBox1.Text = ""
Set Tbl = WS.ListObjects("Data")
Tbl.Range.AutoFilter Field:=2
 Tbl.ShowAutoFilter = False
End Sub

 

test_aziz_3.xlsb