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

У меня есть таблица 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?


merge excel excel-formula vba
person Community    schedule 03.12.2008    source источник

Ответы (2)


arrow_upward
1
arrow_downward

Расширяя ответ Джона Фурнье, я изменил расчет диапазона, чтобы искать непустые ячейки, и добавил код для отключения диалогового окна предупреждения, которое вызывает 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

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

person Community    schedule 04.12.2008

arrow_upward
0
arrow_downward

Это возможно с помощью 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
person Jon Fournier    schedule 03.12.2008
comment
Спасибо за ваш ответ, это выглядит многообещающе. К сожалению, Range(B & CStr(i)).End(xlDown).Row не работает, потому что пустые ячейки не являются пустыми, они содержат формулы. Код объединяет весь столбец с нижней частью последнего подэлемента. - person ; 04.12.2008
comment
Я могу перебирать ячейки в поисках следующей непустой ячейки. Проблема в том, что при слиянии каждый раз появляется диалоговое окно с вопросом, уверен ли я, что хочу перезаписать все объединяемые ячейки. Есть ли способ избавиться от диалогового окна? - person ; 04.12.2008