vba - Excel VBA : There must be a better way to use a loop to delete rows based on cell contents

Question

这个问题在这里已经有了答案:





Fastest way to delete rows which cannot be grabbed with SpecialCells

(3 个回答)



Why my macro doesn't delete all the rows (VBA)

(1 个回答)


5年前关闭。




报告会生成如下所示的工作表:


格式继承自源数据，数据在A，D和G列中，A合并ABC，D合并DEF和G。

我只想保留以蓝色突出显示的行。我希望宏检查 G:G 的内容，如果 Cell.Text = ""然后是 wholerow.delete，否则不要管它。

唯一的问题是当它删除第 2 行时，第 3 行变成第 2 行，这意味着它不会删除它，因为它已经检查了第 2 行。第 4 行现在变成第 3 行，这是下一个要检查的行，并且它看到文本在那里并且没有删除，移动到第四行，删除它，第 5 行变成第 4 行，保持未选中状态，它移动到第 6 行(现在是第 5 行)，看到它是空白的，删除它，但是第 7 行现在变成了第 6 行并且没有被删除......等等。

我发现的唯一方法是使用 GOTO 重新启动循环，然后使用另一个 GOTO 提前退出循环。我很欣赏这可能不是最优雅的解决方案。

iRange = Application.Workbooks(2).Worksheets(2).Cells(Rows.Count, "A").End(xlUp).Row + 1
Debug.Print (iRange)

RestartLoop:

For Each rCell In Application.Workbooks(2).Worksheets(2).Range("G2:G" & iRange)

    If Not rCell.Offset(0, -3).Value = "" Then

        If rCell.Text = "" Then
            Debug.Print (rCell.Address)
            rCell.EntireRow.Delete
            GoTo RestartLoop
        End If

    Else0

        GoTo LeaveLoop

    End If
Next rCell

LeaveLoop:
'Do the next thing

(代码是 Option Explicit: Dim iRange As Integer Dim rCell as Range 在代码顶部的声明中)

这是 debug.print:

26 
$G$2
$G$2
$G$3
$G$3
$G$3
$G$3
$G$3
$G$3
$G$3
$G$3
$G$3
$G$4
$G$4
$G$4
$G$4
$G$4
$G$6
$G$6
$G$7

如果有人知道解决方案，并且也可以为外行解释，我将不胜感激。解决方案需要是动态的，因为每次生成的原始表的长度不同，每次的空白和蓝色单元格的数量也不同。

我搜索了一下，但要么我没有完全理解答案，要么他们似乎给了我同样的问题。

Answer 1

看看下面的内容，它的工作原理是从符合您的条件的单元格中建立一个范围，然后一次性删除所有这些单元格。 测试时，请务必在原始副本上执行此操作，以确保结果符合预期，然后再将其永久化

Dim DeleteRng As Range

Application.ScreenUpdating = False

IRange = Application.Workbooks(2).Worksheets(2).Cells(Rows.Count, "A").End(xlUp).Row + 1

Debug.Print IRange

' This is dangerous, select workbook using ThisWorkbook, or setting the workbook to a variable
' Not just using the number, this could change when opening other workbooks as well
' Similar with above when setting IRange
For Each rcell In Application.Workbooks(2).Worksheets(2).Range("G2:G" & IRange)
    If Not rcell.Offset(0, -3).value = vbNullString And rcell.Text = vbNullString Then
        If DeleteRng Is Nothing Then
            Set DeleteRng = rcell
        Else
            Set DeleteRng = Union(DeleteRng, rcell)
        End If
    End If
Next rcell
Debug.Print DeleteRng.Address
DeleteRng.EntireRow.Delete

Application.ScreenUpdating = True