Sub InsertFormula()
    
    
    '***************
    'Здесь 
    '"=ЕСЛИ("$L$18<>"""";СЧЁТЕСЛИ($D$18:$BH$18;$L$18)>1)"
    'нужно поменять $L$18 на адрес активной ячейки
    'в конечном итоге строка
    'Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=ЕСЛИ($L$18<>"""";СЧЁТЕСЛИ($D$18:$BH$18;$L$18)>1)"
    'должна выглядеть как то так
    'Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=ЕСЛИ(новый адрес<>"""";СЧЁТЕСЛИ($D$18:$BH$18;новый адрес)>1)"
    '***************

    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=ЕСЛИ($L$18<>"""";СЧЁТЕСЛИ($D$18:$BH$18;$L$18)>1)"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 192
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Not Intersect(Target, Range("$H:$H")) Is Nothing And Target.Cells.Count = 1 Then
        Application.EnableEvents = False
        newVal = Target
        Application.Undo
        oldval = Target
        If Len(oldval) <> 0 And oldval <> newVal Then
            Target = Target & ", " & Chr(10) & newVal
        Else
            Target = newVal
        End If
        If Len(newVal) = 0 Then Target.ClearContents
        Application.EnableEvents = True
    End If
End Sub

=СМЕЩ(Код_должность;ПОИСКПОЗ(H2;Сотрудники;0)-1;0;1;1)