Option Explicit

Private indks&, tbl()

Private Sub UserForm_Initialize()
    Dim strk&, i&
    With Sheets("List1")
        strk = .Cells(.Rows.Count, "B").End(xlUp).Row
        tbl = .Range("A2:C" & strk).Value
    End With
    indks = strk - 1
    For i = 1 To indks
        tbl(i, 1) = Application.Trim(tbl(i, 1))
        tbl(i, 2) = UCase(tbl(i, 2))
        tbl(i, 3) = Format(tbl(i, 3), "0000000000000")
    Next
    With UserForm1
        With .ListBox1
            .ColumnCount = -1
            .ColumnWidths = "4cm;12cm;4cm"
            .TextColumn = 1 'Dlya znacheniya v "ListBox1.Text" => "Nomer_per"
            .BoundColumn = 2 'Dlya znacheniya v "ListBox1.Value" => "Familiya Imya Otchestvo"
            .List() = tbl
            .ListIndex = -1
        End With
    End With
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Erase tbl
End Sub

Private Sub TextBox1_Change()
    With UserForm1
        If Trim(.TextBox1.Value) = "" Then
            With .ListBox1
                .Clear
                .List() = tbl
            End With
            Exit Sub
        End If
        Dim i&, j&, tmptbl()
        For i = 1 To indks
            If tbl(i, 2) Like "*" & UCase(.TextBox1.Value) & "*" Then
                j = j + 1
                ReDim Preserve tmptbl(1 To 3, 1 To j)
                tmptbl(1, j) = tbl(i, 1)
                tmptbl(2, j) = tbl(i, 2)
                tmptbl(3, j) = tbl(i, 3)
            End If
        Next
        With .ListBox1
            .Clear
            If j > 0 Then
                .Column() = tmptbl
                Erase tmptbl
            End If
        End With
    End With
End Sub

Private Sub ListBox1_Click()
    Dim strk&, gde_eto As Range
    With Sheets("List1")
        strk = .Cells(.Rows.Count, "B").End(xlUp).Row
        With .Range("B1:B" & strk)
            Set gde_eto = .Find(UserForm1.ListBox1.Value, , xlValues, xlWhole, xlByRows)
        End With
        .Range("B" & gde_eto.Row).Select
        Set gde_eto = Nothing
    End With
End Sub