NomStolbDan = ActiveCell.Column

Private WithEvents App As Application
Dim bu As Boolean
Dim Sh As Worksheet

Dim WBN As String

Private Sub Workbook_Open()
Set App = Application
End Sub

Private Sub App_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
If Not Sh.Name = "fin" Then Exit Sub

If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("C3:C10000")) Is Nothing Then 'serg20200105 "A2:A3000"
If Target.Value <> "" Then: Workbooks("example.xlsm").Worksheets("fin").TextBox1.Visible = False: Workbooks("example.xlsm").Worksheets("fin").ListBox1.Visible = False: Exit Sub
bu = True
With Workbooks("example.xlsm").Worksheets("fin").TextBox1
.Top = Target.Top
.Left = Target.Left
.Height = Target.Height
.Width = Target.Width
.Text = Target.Value
.Activate
End With
With Workbooks("example.xlsm").Worksheets("fin").ListBox1
.Top = Target.Top
.Left = Target.Left + Target.Width
.Width = 420
.Clear
End With
bu = False
Workbooks("example.xlsm").Worksheets("fin").TextBox1.Visible = True
Workbooks("example.xlsm").Worksheets("fin").ListBox1.Visible = True
Else
Workbooks("example.xlsm").Worksheets("fin").TextBox1.Visible = False
Workbooks("example.xlsm").Worksheets("fin").ListBox1.Visible = False
End If
End Sub

Private Sub TextBox1_Change()
Dim X, i, i_end, txt As String, s As String
If Len(TextBox1.Text) = 0 Or bu Then Exit Sub
txt = TextBox1.Text
X = Worksheets("Списки").Columns(1).SpecialCells(2).Value
i_end = Worksheets("Списки").Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To i_end
If UCase(txt) = UCase(Mid(Worksheets("Списки").Cells(i, 1), 1, Len(txt))) _
Or InStr(1, UCase(Worksheets("Списки").Cells(i, 1)), UCase(" " & TextBox1.Value)) > 0 _
Then s = s & X(i, 1) & "~" 'Serg20200105
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