في ليست بوكس :أضافة القيم المكررة مرة واحدة و فلترة الليست بوك حسب قيمة في تكست بوكس

[نايف - م]

السلام عليكم

أريد أضافة القيم المكررة في العمود الأول مرة واحدة

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

شكرا

 

listchange.rar

[ياسر خليل أبو البراء]

أخي الكريم نايف

جرب الكود التالي عله يفي بالغرض

Private Sub ListBox1_Click()
    TextBox1.Value = ListBox1.Value
End Sub

Private Sub TextBox1_Change()
    Dim A, E
    ListBox1.Clear
    
    With Sheets("Names")
        A = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Value
    End With
    
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        For Each E In A
            If InStr(1, E, TextBox1.Value, 1) > 0 Then .Item(E) = E
        Next
        If .Count > 0 Then ListBox1.List = .Keys
    End With
End Sub

Private Sub UserForm_Initialize()
    Dim myList As Collection
    Dim myCell As Range, myRange As Range
    Dim WS As Worksheet
    Dim myVal As Variant
    
    Set WS = ThisWorkbook.Sheets("Names")
    Set myRange = WS.Range("A2", WS.Range("A2").End(xlDown))
    Set myList = New Collection
    
    With Me.ListBox1
        .ColumnCount = 1
        .MultiSelect = fmMultiSelectSingle
        .ColumnWidths = "50"
        
        On Error Resume Next
            For Each myCell In myRange.Cells
                myList.Add myCell.Value, CStr(myCell.Value)
            Next myCell
        On Error GoTo 0
        
        For Each myVal In myList
            .AddItem myVal
        Next myVal
    End With
End Sub

تقبل تحياتي

 

[نايف - م]

تمام

و هو المطلوب

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

يكون على مقاس طلبي بالتمام

حصلت على كود اجنبي لكنه ليس بوضوح و بساطة و فاعلية كودك

شكرا لك

سؤال : نقلت الكود بدون هذا السطر

Private Sub ListBox1_Click()
    TextBox1.Value = ListBox1.Value
End Sub

شو أهميته

[ياسر خليل أبو البراء]

يمكن الاستغناء عنه .. هو ببساطة شديدة عندما تعمل كليك على أي عنصر في القائمة يظهر في التكست بوكس

الحمد لله أن تم المطلوب على خير

تقبل تحياتي