☰

删除行（基于条件）并复制单元格（基于条件）

tag-icon • tag-icon microsoft-excel vba
删除行（基于条件）并复制单元格（基于条件）

我必须修改一个巨大的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 周）以及如何根据条件删除行（例如如果某些单元格为空）？

答案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

相关内容