Sub ClearFromDic()
 Dim iCel As Range, dicRng As Range
 Dim jCel As Range, clearRng As Range
   
    With Sheets("data")
         Set dicRng = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
    End With
      
    With Sheets("List")
         Set clearRng = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
    End With
    
    For Each iCel In dicRng
         clearRng.Replace What:=iCel.Value, _
                          Replacement:="", _
                          LookAt:=xlPart, _
                          SearchOrder:=xlByRows
    Next iCel
    
    
    For Each jCel In clearRng
         jCel.Value = Evaluate("=Trim(" & jCel.Address & ")")
    Next jCel
    
End Sub

' макрос для очистки (удаления) из диапазона всех слов из справочника
Sub ClearFromDic()
 Dim iCel As Range, dicRng As Range
 Dim jCel As Range, clearRng As Range
   
    ' определение диапазона со словами, которые необходимо очистить
    With Sheets("data")
         Set dicRng = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
    End With
    ' определение диапазона, который будем чистить
    With Sheets("List")
         Set clearRng = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
    End With
    
    ' замена всех слов из диапазона dicRng в диапазоне clearRng на "" (пусто) по  очереди
    ' конструкция For Each iCel In dicRng .... Next iCel перебирает все ячейки в диапазоне со словами по очерреди
    For Each iCel In dicRng
         clearRng.Replace What:=iCel.Value, _
                          Replacement:="", _
                          LookAt:=xlPart, _
                          SearchOrder:=xlByRows
    Next iCel
    
    ' удаление лишних пробелов в получившемся диапазоне
    For Each jCel In clearRng
         jCel.Value = Evaluate("=Trim(" & jCel.Address(, , , True) & ")")
    Next jCel
    
End Sub

' макрос для очистки (удаления) из диапазона всех слов из справочника
Sub ClearFromDic2()
 Dim iCel As Range, dicRng As Range
 Dim jCel As Range, clearRng As Range
   
    ' определение диапазона со словами, которые необходимо очистить, в один столбец
    Set dicRng = Application.InputBox("Где словарь", , , , , , ,  8 )
    ' определение диапазона, который будем чистить
    Set clearRng = Application.InputBox("Где заменять", , , , , , ,  8 )
        
    ' вставка функции для определения длины текста
    dicRng.Offset(,  1 ).Formula = "=LEN(RC[-1])"
    'сортировка по длине текста в обратном порядке, столбец справа должен быть свободен
    Debug.Print dicRng.Resize(,  2 ).Address
    dicRng.Resize(,  2 ).Sort Key1:=Range(dicRng( 1 ).Offset(,  1 ).Address(, , , True)), _
                            Order1:=xlDescending, Header:=xlNo, _
                            OrderCustom:= 1 , _
                            MatchCase:=False, _
                            Orientation:=xlTopToBottom

    ' замена всех слов из диапазона dicRng в диапазоне clearRng на "" (пусто) по  очереди
    ' конструкция For Each iCel In dicRng .... Next iCel перебирает все ячейки в диапазоне со словами по очерреди
    For Each iCel In dicRng
         clearRng.Replace What:=iCel.Value, _
                          Replacement:="", _
                          LookAt:=xlPart, _
                          SearchOrder:=xlByRows
    Next iCel
    
    ' удаление лишних пробелов в получившемся диапазоне
    For Each jCel In clearRng
         jCel.Value = Evaluate("=Trim(" & jCel.Address(, , , True) & ")")
    Next jCel
    
End Sub