Как автоматически объединить пустые ячейки сверху/слева в Excel?

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

Объединить пустые ячейки сверху

Объединить пустые ячейки слева

Объединить пустые ячейки сверху на основе столбца

Объединить пустые ячейки сверху (работает только для одного столбца)

Объединить пустые ячейки слева

Объединить пустые ячейки сверху на основе столбца

Предположим, у вас есть диапазон данных в трех столбцах, и вы хотите объединить данные сверху на основе столбца C.

1. Нажмите Alt + F11чтобы открыть окно Microsoft Visual Basic for Applications и нажмите Insert > Module. Смотрите скриншот:

2. Затем вставьте следующий код в пустой скрипт. Смотрите скриншот:

VBA: Объединение пустых ячеек сверху на основе следующего столбца

Sub MergeCells()
'UpdatebyExtendoffice2017025
    Dim xRg As Range
    Dim xCell As Range
    Dim xAddress As String
    On Error Resume Next
    xAddress = Application.ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("Select a range:", "KuTools For Excel", xAddress, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    For Each xCell In xRg
        If xCell.Value = "" Then
            Range(xCell, xCell.Offset(-1, 0)).Merge
        End If
    Next
End Sub

3. Нажмите F5 для запуска кода, после чего появится диалоговое окно с запросом выбрать диапазон для работы. Смотрите скриншот:

4. Нажмите OK, затем пустые ячейки будут объединены сверху. Смотрите скриншот:

Раскройте магию Excel с Kutools AI

• Умное выполнение: Выполняйте операции с ячейками, анализируйте данные и создавайте диаграммы — всё это посредством простых команд.
• Пользовательские формулы: Создавайте индивидуальные формулы для оптимизации ваших рабочих процессов.
• Кодирование VBA: Пишите и внедряйте код VBA без особых усилий.
• Интерпретация формул: Легко разбирайтесь в сложных формулах.
• Перевод текста: Преодолейте языковые барьеры в ваших таблицах.

Улучшите возможности Excel с помощью инструментов на базе ИИ. Скачать сейчас и испытайте беспрецедентную эффективность!

Объединить пустые ячейки сверху (работает только для одного столбца)

Вот макрос, который может объединять пустые ячейки сверху в указанном столбце.

1. Нажмите Alt + F11 чтобы открыть окно Microsoft Visual Basic for Applications и нажмите Insert > Module. Смотрите скриншот:

2. Вставьте следующий код в скрипт. Смотрите скриншот:

VBA: Объединить пустые ячейки сверху

Sub mergeblankswithabove()
'UpdatebyExtendoffice20171025
    Dim I As Long
    Dim xRow As Long
    Dim xRg As Range
    Dim xCell As Range
    Dim xAddress As String
    On Error Resume Next
    xAddress = Application.ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("Select a range (single column):", "KuTools For Excel", xAddress, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    If xRg.Columns.Count > 1 Then
        MsgBox "Only work for single column", , "KuTools For Excel"
        Exit Sub
    End If
    xRow = xRg.Rows.Count
    Set xRg = xRg(xRow)
    For I = xRow To 1 Step -1
        Set xCell = xRg.Offset(I - xRow, 0)
        Debug.Print xCell.Address
        If xCell.Value = "" Then Range(xCell, xCell.Offset(-1, 0)).Merge
    Next
End Sub

3. Нажмите F5 для запуска кода, после чего появится диалоговое окно для выбора диапазона столбца. Смотрите скриншот:

4. Нажмите OK. Пустые ячейки в выбранном диапазоне будут объединены сверху.

Объединить пустые ячейки слева

Если вы хотите объединить пустые ячейки слева, следующий код поможет вам.

1. Нажмите Alt + F11 чтобы открыть окно Microsoft Visual Basic for Applications, и нажмите Insert > Module. Смотрите скриншот:

2. Затем вставьте следующий код в пустой скрипт. Смотрите скриншот:

VBA: Объединить пустые ячейки слева

Sub mergeblankswithleft()
'UpdatebyExtendoffice20171025
    Dim xRg As Range
    Dim xCell As Range
    Dim xAddress As String
    On Error Resume Next
    xAddress = Application.ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("Select a range:", "KuTools For Excel", xAddress, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    For Each xCell In xRg
        If xCell.Value = "" Then Range(xCell, xCell.Offset(0, -1)).Merge
    Next
End Sub

3. Нажмите F5 для запуска кода, после чего появится диалоговое окно для выбора диапазона. Смотрите скриншот:

4. Нажмите OK. Пустые ячейки будут объединены слева.

Объединить пустые ячейки слева