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

Question

Я хочу написать сценарий, который объединит строки с пустой ячейкой в ​​предыдущую строку.

Пример 1

Строка 2 имеет пустую ячейку в последнем столбце. Таким образом, он сливается со строкой 1. Столбец A и B остаются теми же, C перезаписывается, а D является конкатенированным. Строка 2 удаляется.

Пример 2

Ряд 2 и 3 имеют пустые ячейки в последнем столбце. Таким образом, они объединены со строкой 1. Столбец A и B остаются теми же, C перезаписывается, а D объединяется. Строки 2 и 3 удаляются.

Как я могу достичь этого с помощью VBA?

Редактировать: Вот что я достиг до сих пор.

Sub Merge() 
    ActiveSheet.UsedRange.Activate 
    ActiveCell.Offset(0, 4).Select 
    Do While ActiveCell.Row <= ActiveSheet.UsedRange.Rows.Count 
     Do While (IsEmpty(ActiveCell.Offset(1, 0).Value) And Not IsEmpty(ActiveCell.Offset(1, -4))) 
      ActiveCell.Offset(0, -1).Value = ActiveCell.Offset(0, -1).Value + " " + ActiveCell.Offset(1, -1).Value 
      ActiveCell.Offset(0, -2).Value = ActiveCell.Offset(1, -2).Value 
      ActiveCell.Offset(1, 0).EntireRow.Delete shift:=xlShiftUp 
     Loop 
     ActiveCell.Offset(1, 0).Select 
    Loop 
End Sub 

Answer 1

Попробуйте этот код:

Sub Merge() 
Dim rng As Range 
Set ws = Worksheets("Sheet2") 'Change your sheet name 
Set rng = ws.Range("A1").CurrentRegion 
With ws 
    For i = rng.Rows.Count To 1 Step -1 
     If .Cells(i, 5) = "" Then 
      .Cells(i, 3).Offset(-1) = .Cells(i, 3) 
      .Cells(i, 4).Offset(-1) = .Cells(i, 4).Offset(-1) & " " & .Cells(i, 4) 
      .Rows(i).EntireRow.Delete 
     End If 
    Next 
End With 
End Sub