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

[OlgaK]

Удалить или объединить с заполненной ячейкой выше

[staniiislav]

Сообщение от OlgaK

Удалить или объединить с заполненной ячейкой выше

попробуйте так:

Sub OlgaK()
Dim lRow&, i&, j&, n&, t, rDel As Range
t = Timer
Application.ScreenUpdating = False
lRow = Cells(Rows.Count, 1).End(xlUp).Row

For i = 4 To lRow
    If Cells(i, 1) > 0 Then
        For j = i + 1 To lRow
            If IsEmpty(Cells(j, 1)) And IsEmpty(Cells(j, 3)) And IsEmpty(Cells(j, 4)) Then
                If rDel Is Nothing Then Set rDel = Range(Cells(j, 3), Cells(j, 3)) Else Set rDel = Union(rDel, Range(Cells(j, 3), Cells(j, 3)))
            End If
            If Cells(j, 1) > 0 Then
                With Range(Cells(i, 1), Cells(j - 1, 1))
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    .WrapText = True
                    .Orientation = 0
                    .AddIndent = False
                    .IndentLevel = 0
                    .ShrinkToFit = False
                    .ReadingOrder = xlContext
                    .MergeCells = True
                End With
                With Range(Cells(i, 2), Cells(j - 1, 2))
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    .WrapText = True
                    .Orientation = 0
                    .AddIndent = False
                    .IndentLevel = 0
                    .ShrinkToFit = False
                    .ReadingOrder = xlContext
                    .MergeCells = True
                End With
                Exit For
            End If
        Next j
    i = j - 1
    End If
Next i

If Not rDel Is Nothing Then rDel.EntireRow.Delete
Application.ScreenUpdating = True
MsgBox "Время обработки: " & Timer - t, vbInformation, "Объединение"
End Sub

пример удаления строки взят вот от сюда:
http://excelvba.ru/code/ConditionalRowsDeleting

[OlgaK]

Огромнейшее спасибо! То, что доктор прописал.