Как автоматически объединить ячейки?

Question

У меня есть таблица Excel с несколькими элементами 1, 2, 3 ..., каждый из которых имеет подпункты 1.1, 1.2 и т. Д. Я использую список подэлементов в качестве ключевого столбца и заполняю основные элементы с помощью vlookups , но показывать каждый основной элемент только один раз.

/|    A    |    B     |    C     |
-+---------+----------+----------+
1| Item1   |  1.Note  |  Item1.1 |
2|         |          |  Item1.2 |
3|         |          |  Item1.3 |
4| Item2   |  2.Note  |  Item2.1 |
5|         |          |  Item2.2 |
6|         |          |  Item2.3 |
7|         |          |  Item2.4 |
8| Item3   |  3.Note  |  Item3.1 |
9|         |          |  Item3.2 |
0|         |          |  Item3.3 |

Столбец C - необработанные данные; A и B являются формулами.

В столбце B есть примечания, поэтому текст может быть длинным. Я хочу обернуть заметки, чтобы занять все доступные строки. Я могу сделать это вручную, выбрав B1:B3 и объединив их, но тогда я не обновлюсь, если я добавлю элементы в столбец C.

Мне все равно, если ячейки слиты или просто обернуты и перекрываются.

Можно ли это сделать в формулах или VBA?

Answer 1

Расширяя ответ Джона Фурнье, я изменил расчет диапазона, чтобы искать непустые ячейки, и добавил код для отключения диалогового окна с предупреждением, которое выдает Merge. Я также изменил функцию на Public, чтобы можно было запустить ее из диалога Macros.

Public Sub AutoMerge()

Dim LastRowToMergeTo As Long
Dim i As Long
Dim LastRow As Long

Application.DisplayAlerts = False

LastRow = Range("S" & CStr(Rows.Count)).End(xlUp).Row

For i = 2 To LastRow

    LastRowToMergeTo = i
    Do While (Len(Range("D" & CStr(LastRowToMergeTo + 1)).Value) = 0) And (LastRowToMergeTo <> LastRow)
        LastRowToMergeTo = LastRowToMergeTo + 1
    Loop

    With Range("D" & CStr(i) & ":D" & CStr(LastRowToMergeTo))
        .Merge
        .WrapText = True
        .VerticalAlignment = xlVAlignTop
    End With

    i = LastRowToMergeTo

Next i

Application.DisplayAlerts = True

End Sub

Вторая часть Джона, которая должна запускать макрос при каждом пересчете, кажется, не работает, но не имеет значения для меня из-за небольшого количества обновлений, которые я делаю.

Answer 2

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

Я создал простую электронную таблицу, похожую на вашу, и поместил следующий код в модуль кода листа:

Private Sub AutoMerge()

Dim LastRowToMergeTo As Long
Dim i As Long
Dim LastRow As Long

LastRow = Range("C" & CStr(Rows.Count)).End(xlUp).Row

For i = 2 To LastRow

    LastRowToMergeTo = Range("B" & CStr(i)).End(xlDown).Row - 1
    LastRowToMergeTo = Application.WorksheetFunction.Min(LastRowToMergeTo, LastRow)

    With Range("B" & CStr(i) & ":B" & CStr(LastRowToMergeTo))
        .Merge
        .WrapText = True
        .VerticalAlignment = xlVAlignTop
    End With

    i = LastRowToMergeTo

Next i

End Sub

Private Sub Worksheet_Calculate()
    AutoMerge
End Sub