المساعدة في عمل كود بحث في الكمبوبوكس

[yasse.w.2010]

السلام عليكم .. فلابد من التحية عند بدء المشاركة ,الاساتذه الكرام ممكن تعديل على هذا الكود بحيث يقبل البحث باي حرف في الاسم بالكامل 

وكذا عند الكتابه تظهر الاسماء اسفل الكمبوبوكس ..شاكر لكم جدا

القائمة بالكومبوبوكس.xlsm

[Ali Mohamed Ali]

وعليكم السلام-تفضل

Option Explicit
Private IsArrow As Boolean
Private Sub ComboBox1_Change()
    Dim i As Long
      If Not IsArrow Then
        With Me.ComboBox1
            .List = Worksheets("Sheet1").Range("A4", Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)).Value
            .ListRows = Application.WorksheetFunction.Min(6, .ListCount)
            .DropDown
            If Len(.Text) Then
                For i = .ListCount - 1 To 0 Step -1
                    If InStr(1, .List(i), .Text, vbTextCompare) = 0 Then .RemoveItem i
                Next
                .DropDown
            End If
                    End With
    End If
  End Sub
Private Sub ComboBox1_DropButtonClick()
    With Me.ComboBox1
        .List = Worksheets("Sheet1").Range("A4", Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)).Value
        .ListRows = Application.WorksheetFunction.Min(6, .ListCount)
        .DropDown
    End With
End Sub
Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Debug.Print Time; "KeyDown"; KeyCode; ComboBox1.ListIndex; ComboBox1.ListCount, ComboBox1.Value
          IsArrow = (KeyCode = vbKeyUp) Or (KeyCode = vbKeyDown)
      If KeyCode = vbKeyReturn Then
        Me.ComboBox1.List = Worksheets("Sheet1").Range("A4", Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)).Value
    ElseIf KeyCode = vbKeyTab Then
                With Me.ComboBox1
            If .ListIndex = -1 Then
                .Value = .List(0)
            Else
                .Value = .List(.ListIndex)
            End If
        End With
        KeyCode = vbKeyReturn
    End If
  End Sub

القائمة بالكومبوبوكس1.xlsm