vba - 根据填充颜色索引删除行

Question

我正在尝试删除 A7:AI300 范围内包含黄色填充单元格(颜色索引 6)的所有行我有一些代码将删除包含该颜色的所有行但我遇到的问题是它正在尝试运行整个工作表的代码并会卡住我的工作簿。我正在尝试插入一个范围以加快计算速度。谁能告诉我如何插入范围以便它起作用

Sub deleterow()
   Dim cell As Range
   For Each cell In Selection
       If cell.Interior.ColorIndex = 6 Then
           cell.EntireRow.Delete
       End If
   Next cell
End Sub

Answer 1

这就是你正在尝试的吗？请注意，我们并不是删除循环内的每一行，而是创建最终的“删除范围”，这将确保您的代码运行得更快。

编辑:如果您正在查看范围“A7:A300”，则使用此代码

Sub deleterow()
   Dim cell As Range, DelRange As Range

   For Each cell In ThisWorkbook.Sheets("Sheet1").Range("A7:A300")
       If cell.Interior.ColorIndex = 6 Then
           If DelRange Is Nothing Then
               Set DelRange = cell
           Else
               Set DelRange = Union(DelRange, cell)
           End If
       End If
   Next cell

   If Not DelRange Is Nothing Then DelRange.EntireRow.Delete
End Sub

如果您正在查看范围“A7:AI300”，那么我想这就是您想要的。

Sub deleterow()
   Dim cell As Range, DelRange As Range

   For Each cell In ThisWorkbook.Sheets("Sheet1").Range("A7:AI300")
       If cell.Interior.ColorIndex = 6 Then
           If DelRange Is Nothing Then
               Set DelRange = cell
           Else
               Set DelRange = Union(DelRange, cell)
           End If
       End If
   Next cell

   If Not DelRange Is Nothing Then DelRange.Delete
End Sub

更多跟进

我想我可能终于明白了你想要实现的目标......

Sub deleterow()
    Dim i As Long, j As Long
    Dim delRange As Range

    With ThisWorkbook.Sheets("Sheet1")
        For i = 7 To 300 '<~~ Row 7 to 300
            For j = 1 To 35 <~~ Col A to AI
                If .Cells(i, j).Interior.ColorIndex = 6 Then
                    If delRange Is Nothing Then
                        Set delRange = .Cells(i, j)
                    Else
                        Set delRange = Union(delRange, .Cells(i, j))
                    End If
                    Exit For
                End If
            Next j
        Next i
    End With

    If Not delRange Is Nothing Then delRange.EntireRow.Delete
End Sub