Private Sub TextBox1_change()
    Dim X, i, txt As String, lt, s As String, sn As String, NomStolbDan As Long
    sn = "Данные" ' Имя листа с данными
    If Len(TextBox1.Text) = 0 Or bu Then Exit Sub
    txt = TextBox1.Text
    lt = Len(TextBox1.Text)
    NomStolbDan = ActiveCell.Column
    X = Sheets(sn).Columns(NomStolbDan).SpecialCells(2).Value
    For i = 1 To Sheets(sn).Cells(Rows.Count, NomStolbDan).End(xlUp).Row
        If InStr(1, UCase(Sheets(sn).Cells(i, NomStolbDan)), UCase(TextBox1.Value)) > 0 Then s = s & X(i, 1) & "~" 'формирует по сочетанию букв в любом месте текста
        'If UCase(txt) = UCase(Mid(Sheets("Данные").Cells(i, NomStolbDan), 1, lt)) Then s = s & X(i, 1) & "~" 'формирует по сочетанию букв в начале текста
    Next i
    ListBox1.List = Split(s, "~")
End Sub


Private Sub ListBox1_Click()

    If ListBox1.ListIndex = -1 Then Exit Sub
    bu = True
    ActiveCell.Value = ListBox1.Value
    Me.TextBox1.Visible = False
    Me.ListBox1.Visible = False
    bu = False
End Sub