اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

قام بنشر (معدل)

السلام عليكم

انا طلبي في يوزرفورم وليس في الشيت

 المطلوب كود تصفية لليست بوكس معتمدا على تكست بوكس

ارجو الرد

 

تم تعديل بواسطه محسن33
قام بنشر

هذا هو الكود

Private Sub UserForm_Initialize()
 Me.ListBox1.List = Range("A2", Cells(Rows.Count, 1).End(xlUp)).Value
End Sub
 
Private Sub FilterBasedonText_Click()
Call TextBox1_AfterUpdate
End Sub


Private Sub TextBox1_AfterUpdate()
Dim StrSearch As String
Dim MyRowNo As Long

StrSearch = "*" & UCase(Me.TextBox1.Text) & "*"

With Me.ListBox1
For MyRowNo = .ListCount - 1 To 0 Step -1
    If Not UCase(.List(MyRowNo)) Like StrSearch Then
        .RemoveItem (MyRowNo)
    End If
Next
End With

End Sub
Private Sub ShowAll_Click()
 Call UserForm_Initialize
End Sub


Private Sub RemoveSelected_Click()
 Me.ListBox1.RemoveItem (Me.ListBox1.Selected = True)
End Sub

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

Private Sub UserForm_Initialize()
 Me.ListBox1.RowSource = "sheet1!a1:a" & Sheets("sheet1").Range("a" & Rows.Count).End(xlUp).Row
End Sub

 ثم تبين أن أمر  RemoveItem

لا يعمل عند وجود بيانات فى 

Rowsource

الخاص يالقائمة

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

 

مرفق الملف

 

image.png.e9d44ee2428b695e6b8f88584a6c29f6.png

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

ثم اضغط Enter

 او اضغط على زر Filter

و لاظهار كافة البيانات اضغط 

Show All

FilterListbox.xlsm

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • اضف...

Important Information