Option Explicit
Option Base 1
Public DicAll As Dictionary
Private Sub ComCH_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
   Dim n As Long ' lRow
   Dim iCol As Long
   iCol = 0
   Dim TextCom As String
   TextCom = ComCH.Text
   Dim Lst()
   Dim NewLst()
   If KeyCode <> 38 And KeyCode <> 40 And KeyCode <> 13 Then
     With Sheets("Отметки")
        Lst = DicAll(ComKod.Text)
        'n = UBound(Lst)
     End With
     If TextCom = "" Then ComCH.List = Lst: Exit Sub
     ComCH.Clear
     Erase NewLst
     For n = 1 To UBound(Lst)
       If InStr(1, Lst(n, 1), TextCom, vbTextCompare) Then
         iCol = iCol + 1
         ReDim Preserve NewLst(iCol)
         NewLst(iCol) = Lst(n, 1)
       End If
     Next n
     If iCol <> 0 Then ComCH.List = NewLst
   End If
End Sub
Private Sub ComCH_Change()
  ComCH.DropDown
End Sub
Private Sub ComKod_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Dim num As Long ' lRow
    Dim iCol As Long
    iCol = 0
    Dim TextCom As String
    TextCom = ComKod.Text
    Dim Lst()
    Dim NewLst()
    If KeyCode <> 38 And KeyCode <> 40 And KeyCode <> 13 Then
      With Sheets("Отметки")
         num = .Cells(Rows.Count, 1).End(xlUp).Row
         Lst = .Range(.Cells(2, 1), .Cells(num, 2)).Value
      End With
      If TextCom = "" Then ComKod.List = Lst: Exit Sub
      ComKod.Clear
      Erase NewLst
      For num = 1 To UBound(Lst)
        If InStr(1, Lst(num, 1), TextCom, vbTextCompare) Then
           iCol = iCol + 1
           ReDim Preserve NewLst(iCol)
           NewLst(iCol) = Lst(n, 1) & " " & Lst(num, 2)
        End If
      Next num
      If iCol <> 0 Then ComKod.List = NewLst
    End If
End Sub
Private Sub ComKod_Change()
     ComKod.DropDown
End Sub
'---------------------------------------------------------
Private Sub UserForm_Initialize()
    Dim lKod As Long
    Dim lName As Long
    Dim i As Integer
    Dim j As Integer
    Dim ArrNames As Variant
    Dim ArrCount As Integer
    ArrCount = 0
    Set DicAll = New Dictionary
    ComKod.MatchEntry = fmMatchEntryNone
    With Sheets("Отметки")
        lKod = .Cells(Rows.Count, 1).End(xlUp).Row
        lName = .Cells(1, Columns.Count).End(xlToLeft).Column
        ComKod.List = .Range(.Cells(2, 1), .Cells(lKod, 2)).Value
        For j = 2 To lKod
             lName = .Cells(j, Columns.Count).End(xlToLeft).Column
             ReDim ArrNames(lName - 2)
             For i = 3 To lName
                  ArrNames(i - 2) = .Cells(j, i).Value
             Next i
             DicAll.Add .Cells(j, 1).Value, ArrNames
       Next j
   End With
End Sub