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

Answer 2

这是你可以做的。将计算置于手动模式。设置您需要删除的范围，而不是selecting...

Sub deleterow()
     Dim myRange as Range
     Dim cell As Range

     Application.Calculation = xlCalculationManual
     Set myRange = Worksheets(1).Range("A1:A300") '-- just column A would do

     For Each cell In myRange
        If cell.Interior.ColorIndex = 6 Then
          cell.EntireRow.Delete
        End If
     Next cell

     Application.Calculation = xlCalculationAutomatic
 End Sub