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

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

Это возможно с помощью 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 

Answer 2

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

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 

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