Макрос на объединение ячеек

[Kapkom]

Добрый день!

Извините за возможно банальную тему, но в предыдущих аналогичных темах не нашел ответа на мой вопрос.
В-общем, подскажите, пожалуйста, что необходимо прописать в макросе, чтобы при его запуске объединялись ячейки одной строки, если значения вышестоящих ячеек, к примеру, предыдущей строки, одинаковы.
Например, в ячейках C2, D2 и E2 по установленной в них формуле рассчиталось определенное одинаковое значение, а в ячейках F2, G2 и H2 - рассчиталось другое одинаковое значение. Необходимо, чтобы при запуске макроса ячейки C3, D3 и E3 объединились в единую ячейку, а ячейки F3, G3 и H3 - в другую единую ячейку.

Буду очень признателен за помощь.

Заранее большое спасибо.

[Казанский]

Приложите файл-пример, постарайтесь в нем учесть разные варианты.
Например, если C2 и D2 совпадают, а E2 нет - объединять 2 ячейки или ни одной?
А если 4 ячейки подряд совпадают?
Диапазон поиска одинаковых значений Вы назначите (выделением) или макрос сам должен определить?

[Kapkom]

Во вложении - файл с двумя примерами.
Ответы на Ваши вопросы:
1. "если C2 и D2 совпадают, а E2 нет - объединять 2 ячейки или ни одной?" - объединять две ячейки.
2. "если 4 ячейки подряд совпадают?" - объединять 4 ячейки.
3. "Диапазон поиска одинаковых значений Вы назначите (выделением) или макрос сам должен определить?" - я предполагал, что диапазон поиска будет полностью какая-нибудь конкретная строка. Пусть это будет строка 3, а объединение ячеек будет идти по строке 4.

[Kapkom]

Во вложении - файл с двумя примерами.
Ответы на Ваши вопросы:
1. "если C2 и D2 совпадают, а E2 нет - объединять 2 ячейки или ни одной?" - объединять две ячейки.
2. "если 4 ячейки подряд совпадают?" - объединять 4 ячейки.
3. "Диапазон поиска одинаковых значений Вы назначите (выделением) или макрос сам должен определить?" - я предполагал, что диапазон поиска будет полностью какая-нибудь конкретная строка. Пусть это будет строка 3, а объединение ячеек будет идти по строке 4.

[Kapkom]

Извините, пожалуйста, за беспокойство! Скажите, пожалуйста, есть какие-нибудь варианты по данной теме?

[Казанский]

Пробуйте

Sub Kapkom()
Const CHKROW& = 3 'проверяемая строка
Dim i&, j&
Application.DisplayAlerts = False
j = 1
For i = j To Cells(CHKROW, Columns.count).End(xlToLeft).Column + 1
  If Cells(CHKROW, j) <> Cells(CHKROW, i) Then
    If i - j > 1 Then
      With Cells(CHKROW + 1, j).Resize(, i - j)
        .Merge
        .HorizontalAlignment = xlCenter
      End With
     End If
    j = i
  End If
Next
Application.DisplayAlerts = True
End Sub

[Kapkom]

Вот это да - все работает!!! Даже не представлял, если честно, что такое возможно. Спасибо Вам огромное! Вы мне очень помогли!