Объединение ячеек по условию.

[oniava]

Здравствуйте коллеги.

Интересует макрос, который бы объединял ячейки по заданному условию и помещал текст в центре (или с краю в левой ячейке)
Условие, поиск текста в таблице и при нахождении нужного теста, происходит объединение с А по D.

Sub ОбъединениеЯчеек()
  ' Объединяем  с 15 строки

    Dim ra As Range, delra As Range
    Application.ScreenUpdating = False    ' отключаем обновление экрана

    ' ищем и удаляем строки, содержащие заданный текст
    ' (можно указать сколько угодно значений, и использовать подстановочные знаки)
    СтрокиСТекстом = Array("Parameter List:", "main settings", "phases", "operating mode", "contactor")
 
    ' перебираем все строки в используемом диапазоне листа
    For Each ra In ActiveSheet.UsedRange.Rows
        ' перебираем все фразы в массиве
If ra.Row >= 15 Then
        For Each word In СтрокиСТекстом
        
            ' если в очередной строке листа найден искомый текст
            If Not ra.Find(word, , xlValues, xlPart) Is Nothing Then

                ' добавляем строку в диапазон для объединения
                If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
            End If
        Next word
End If
    Next
    
    ' если подходящие строки найдены, то: (оставьте одну из следующих строк)

   Здесь код для объединения

    ' If Not delra Is Nothing Then delra.EntireRow.Hidden = True    ' скрываем их
    ' If Not delra Is Nothing Then delra.EntireRow.Delete    ' удаляем их
End Sub

Может и как то по другому все это делается, я не силен в данной теме.
Подскажите пожалуйста, как это можно сделать?

Фай в котором будет выполняться поиск.
QF1 яч. 1-1 РМ(Р)0101А.xlsx

[Hugo121]

Sub ОбъединениеЯчеек()
' Объединяем  с 15 строки

    Dim ra As Range, delra As Range
    Application.ScreenUpdating = False    ' отключаем обновление экрана

    ' ищем и удаляем строки, содержащие заданный текст
    ' (можно указать сколько угодно значений, и использовать подстановочные знаки)
    СтрокиСТекстом = Array("Parameter List:", "main settings", "phases", "operating mode", "contactor")

    ' перебираем все строки в используемом диапазоне листа
    For Each ra In ActiveSheet.UsedRange.Rows
        ' перебираем все фразы в массиве
        If ra.Row >= 15 Then
            For Each word In СтрокиСТекстом

                ' если в очередной строке листа найден искомый текст
                If Not ra.Find(word, , xlValues, xlWhole) Is Nothing Then '!!!xlWhole!!!!

                    ' добавляем строку в диапазон для объединения
                    If delra Is Nothing Then Set delra = Intersect(Columns("A:D"), ra) Else Set delra = Union(delra, Intersect(Columns("A:D"), ra))
                End If
            Next word
        End If
    Next

    ' если подходящие строки найдены, то: (оставьте одну из следующих строк)

    'Здесь код для объединения
    delra.Merge True

    ' If Not delra Is Nothing Then delra.EntireRow.Hidden = True    ' скрываем их
    ' If Not delra Is Nothing Then delra.EntireRow.Delete    ' удаляем их
End Sub

Если ещё нужно форматирование - запишите рекордером и добавьте.