Удаляет строки (в зависимости от условия) и копирует ячейки (в зависимости от условия)

Question

Я должен изменить огромный сценарий VBA , я новичок в VBA и должен сказать, что мне это не нравится :( Мне нужна помощь в написании эффективного цикла For, позвольте мне объяснить на примере.

Во время первого преобразования я хочу:

• скопируйте ячейку недели во все пустые ячейки, пока она не достигнет новой недели
• скопируйте ячейку имени человека во все пустые ячейки, пока не достигнете нового человека

На втором этапе я хочу:

• удалить все строки, где ячейки C & D & E пусты

Я попробовал следующий код, чтобы удалить строки, если столбец C пуст, и он работает, но я хочу удалить, если все столбцы C & D & E пусты.

On Error Resume Next
'ActiveSheet.Range(Columns(C), Columns(E)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete does not work
ActiveSheet.Columns(C).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0

Я хотел бы сделать это на месте, я хочу видеть результат вместо исходных ячеек.

Как можно скопировать ячейки на основе условия (например, копирование недели X) и как можно удалить строку на основе условия (например, если некоторые ячейки пусты)?

Answer 1

Я решил это сам.

' Copy week & name to all rows
For i = 1 To ActiveSheet.UsedRange.Rows.Count - 1 Step 1
    If IsEmpty(ActiveSheet.Range("A" & i + 1)) Then
        ActiveSheet.Range("A" & i).Copy Destination:=ActiveSheet.Range("A" & i + 1) ' Week
    End If
    If IsEmpty(ActiveSheet.Range("B" & i + 1)) Then
        ActiveSheet.Range("B" & i).Copy Destination:=ActiveSheet.Range("B" & i + 1) ' Name
    End If
Next i

' Delete entire rows where there is no number (this emplies the row is invalid)
On Error Resume Next
ActiveSheet.Columns("E").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0