Как удалить определенный текст сразу в нескольких ячейках?

Ответьте на следующий вопрос: можно ли запустить этот макрос быстрее? - Я отправляю свой ответ здесь и голосую, чтобы закрыть этот вопрос как дубликат.

Если я вас понимаю, вы хотите взять все значения в столбце H и удалить их из столбца E? Я бы сделал это с некоторыми массивами, чтобы ускорить это -

Option Explicit
Sub DoTheThing()
Application.ScreenUpdating = False
Dim lastrow As Integer
'Find last row in column H to size our array
lastrow = ActiveSheet.Cells(Rows.Count, "H").End(xlUp).row

'Declare the array and then resize it to fit column H
Dim varkeep() As Variant
ReDim varkeep(lastrow - 1)

'Load column H into the array
Dim i As Integer
For i = 0 To lastrow - 1
    varkeep(i) = Range("H" & i + 1)
Next

Dim member As Variant
'find last row in column E
lastrow = ActiveSheet.Cells(Rows.Count, "E").End(xlUp).row

'loop each cell in column E starting in row 2 ending in lastrow
For i = 2 To lastrow
    'Make a new array
    Dim myArray As Variant
    'Load the cell into the array
    myArray = Split(Cells(i, 5), " ")
    Dim k As Integer
    'for each member of this array
    For k = LBound(myArray) To UBound(myArray)
        member = myArray(k)
        'call the contains function to check if the member exists in column H
        If Contains(varkeep, member) Then
            'if it does, set it to nothing
            myArray(k) = vbNullString
        End If
    Next
    'let's reprint the array to the cell before moving on to the next cell in column E
    Cells(i, 5) = Trim(Join(myArray, " "))
Next
Application.ScreenUpdating = True
End Sub


Function Contains(arr As Variant, m As Variant) As Boolean
    Dim tf As Boolean
    'Start as false
    tf = False
    Dim j As Integer
        'Search for the member in the keeparray
        For j = LBound(arr) To UBound(arr)
            If arr(j) = m Then
                'if it's found, TRUE
                tf = True
                Exit For
            End If
        Next j
        'Return the function as true or false for the if statement
        Contains = tf
End Function

Это создает массив из столбца H. Затем он проходит через каждую ячейку в столбце E, анализирует его в массиве, ищет каждый элемент этого массива в массиве keep и, если он найден, удаляет этот элемент массива. Пройдя через ячейку, он перепечатывает массив с отсутствующими найденными.

Массивы, как правило, работают быстрее, чем переходы от элемента к элементу, но кроме того, мы создаем нашу собственную функцию, а не используем медленную Find and Replace метод. Единственная проблема заключается в том, что в данных могут быть лишние пробелы. Если это так, мы можем быстро найти и заменить это. Я обнаружил, что проще установить элементы массива на ничего, чем изменить размер массива и переместить элементы.

Просто для полноты, вот процедура, которая удаляет лишние пробелы из столбца E

Sub ConsecSpace()
Dim c As Range
Dim lastrow As Integer
lastrow = ActiveSheet.Cells(Rows.Count, "E").End(xlUp).Row
Dim strValue As String
For Each c In Range("E2:E" & lastrow)
    strValue = c.Value
    Do While InStr(1, strValue, "  ")
        strValue = Replace(strValue, "  ", " ")
    Loop
    c = strValue
Next
End Sub