For Each rc In Rng
                If InStr(rc.Formula, "INDIRECT") > 0 And Len(rc.Formula) > 30 Then
                    rc.Value = rc.Value
                End If
            Next rc

ЕСЛИОШИБКА(
        ГИПЕРССЫЛКА("file:///W:\ОТДЕЛ ПРОДАЖ\ЭПТС\" & C15 & "\" & ПОДСТАВИТЬ(I15;" ";"%20") & ".pdf"; "ССЫЛКА");
        "")
    )

=ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(";;"&ЕСЛИ(D3>0;$D$1;"")&ЕСЛИ(E3>0;";"&$E$1;"")&ЕСЛИ(F3>0;";"&$F$1;"")&ЕСЛИ(G3>0;";"&$G$1;"")&ЕСЛИ(I3>0;";"&$I$1;"")&ЕСЛИ(J3>0;";"&$J$1;"");";;;;";"");";;;";"");";;";"")

=ОБЪЕДИНИТЬ(";";1;УНИК(ФИЛЬТР($D$1:$J$1;$D3:$J3>{0;0;0;0;1000000;0;0};"-")))

Function Sort1(SheetRange1 As Range, SheetRange2 As Range, Optional FillEmptyBy$ = "")
Dim Temp, DataPrimary, DataSlave, Result(), ResultText(), IndexP, i&, j&, k&, x&, m&
Dim rr As Range, xru&
Set rr = Application.Caller

'задаю массиву значения диапазона
DataPrimary = SheetRange1.Value
DataSlave = SheetRange2.Value

IndexP = Array("a", "b", "c", "d", "e", "f", "g", "h", "i", "j")

'удаляю дубли
For i = LBound(DataPrimary) To UBound(DataPrimary) - 1
    For j = i + 1 To UBound(DataPrimary)
        If DataPrimary(i, 1) = DataPrimary(j, 1) And DataPrimary(i, 1) <> 0 Then DataPrimary(j, 1) = 0
    Next j
Next i

'расставляю по возрастанию
For i = LBound(DataPrimary) To UBound(DataPrimary) - 1
    For j = i + 1 To UBound(DataPrimary)
        If DataPrimary(i, 1) > DataPrimary(j, 1) Then
            Temp = DataPrimary(i, 1)
            DataPrimary(i, 1) = DataPrimary(j, 1)
            DataPrimary(j, 1) = Temp
        End If
    Next j
Next i

'переопределяю размерность массива без нулей
For i = LBound(DataPrimary) To UBound(DataPrimary)
    If DataPrimary(i, 1) > 0 Then x = x + 1
Next i
ReDim Result(1 To x, 1 To 11)

'переношу данные без нулей в верном порядке
For i = x To 1 Step -1
    Result(i, 1) = DataPrimary(i + UBound(DataPrimary) - UBound(Result), 1)
Next i

'выстраиваю двемерный массив типов и ширин
DataPrimary = SheetRange1.Value
For i = LBound(Result) To UBound(Result)
    For j = LBound(DataPrimary) To UBound(DataPrimary)
        If Result(i, 1) = DataPrimary(j, 1) Then
            For k = 2 To 11
                Result(i, k) = Result(i, k) + DataSlave(j, k - 1)
            Next k
        End If
    Next j
Next i

'считаю количество строк ответа
x = 0
For i = LBound(Result) To UBound(Result)
    For j = 2 To 11
        If Result(i, j) > 0 Then x = x + 1
    Next j
Next i
xru = x
ReDim ResultText(1 To rr.Rows.Count, 1 To 1)

'собираю массив конечного ответа
For i = LBound(ResultText, 1) To xru 'UBound(ResultText, 1)
    For j = LBound(Result, 1) To UBound(Result, 1)
        If Result(j, 1) > 0 Then
            For k = 2 To 11
                If Result(j, k) > 0 Then
                    ResultText(i, 1) = Result(j, 1) * 10 & "-" & IndexP(k - 2)
                    Result(j, k) = 0
                    GoTo NextResult
                End If
            Next k
        End If
    Next j

NextResult:
    x = 0
    For k = 2 To 11
        If Result(j, k) > 0 Then x = x + 1
    Next k
    If x = 0 Then Result(j, 1) = 0
Next i
If xru < rr.Rows.Count Then
    For i = xru + 1 To rr.Rows.Count
        ResultText(i, 1) = FillEmptyBy
    Next
End If
Sort1 = ResultText
End Function

Dim avFiles
    Dim WB As Workbook
    avFiles = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", 1, "Выбрать Excel файл", , False)
    If VarType(avFiles) = vbBoolean Then
        MsgBox "Файл не выбран", 0, "Выбор файла"
        Exit Sub
    End If
    On Error Resume Next
    Application.DisplayAlerts = False
    Set WB = Workbooks.Open(avFiles, ReadOnly:=True)
    If WB Is Nothing Then
        MsgBox "Возникла ошибка при открытии файла"
        Application.DisplayAlerts = True
        Exit Sub
    Else
        if Right(WB.Name,4) = ".xls" Then'если это файл формата xls - пересохраняем
          WB.SaveAs WB.FullName & "x",FileFormat:=51
        end if
'и где-то здесь записываете путь к этой книге и закрываете
Cells(1,1).value = WB.FullName
WB.Close False 'или True, если были какие-то изменения и надо сохранить книгу
    End If