Option Explicit
'====================================================================================================
' для RE можно подключить библиотеку и будет быстрее
' для контроля уникальности списка замен можно использовать словарь
' если список замен для функции всегда один (для файла), то нужно сделать переменную статической (как регулярка) - будет НАМНОГО быстрее
' вместо макроФУНКЦИИ часто намного быстрее будет работать макроПРОЦЕДУРА (взять, обработать и выгрузить)
'====================================================================================================
Function Replacer(vl$, rngList As Range)
Dim x, arr, arrList(), n&
Dim ar As Range, cl As Range
Static REdel As Object, REtrim As Object, fStatic As Boolean

Replacer = ""
If Len(vl) = 0 Then Exit Function

    If Not fStatic Then
        fStatic = True

        Set REdel = CreateObject("vbscript.regexp")
        REdel.Global = True
        REdel.Pattern = "[^ 0-9A-Za-zЁёА-я]+"   ' для удаления (замены на ничего) всего, кроме пробелов, цифр, латиницы и кириллицы - соответственно

        Set REtrim = CreateObject("vbscript.regexp")
        REtrim.Global = True
        REtrim.Pattern = " +"                ' для сжатия пробелов
    End If

ReDim arrList(1 To rngList.Cells.Count)
arr = rngList.Value

    If Not IsArray(arr) Then    ' если не массив, то список состоит из 1 ячейки
        n = n + 1
        arrList(n) = arr
    Else                        ' если массив, то цикл по всем элементам
        For Each x In arr
            n = n + 1
            arrList(n) = x
        Next x
    End If

    For Each x In arrList   ' удаляем элементы по списку
        If InStr(1, vl, x, vbTextCompare) Then vl = Replace(vl, x, "", , , vbTextCompare)
    Next x

If REdel.test(vl) Then vl = REdel.Replace(vl, " ")      ' если есть, что удалять, то заменяем на пробелы
vl = Trim(vl)                                           ' удаляем ведущие и хвостовые пробелы
If InStr(vl, "  ") Then vl = REtrim.Replace(vl, " ")    ' если есть двойные пробелы, то сжимаем (заменяем на одинарные)

Replacer = vl
End Function
'====================================================================================================