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

Delete row based on fill color index

提问by David Van der Vieren

I am trying to delete all rows with in the range of A7:AI300that contain a cell with yellow fill (Color index 6) I have some code that will delete all rows that contain the color but the problem I am having is that it is trying to run the code for the whole worksheet and will freeze my workbook. I am trying to insert a range to speed up the calculations. Can anyone show me how to insert the range so it works

我正在尝试删除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

回答by Siddharth Rout

Is this what you are trying? Notice that we are not deleting each row inside the loop but creating our final "Delete Range" This will ensure that your code runs faster.

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

EDIT: If you are looking at range "A7:A300"then use this code

编辑：如果您正在查看范围，请"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

And if you are looking at range "A7:AI300"then I guess this is what you want.

如果您正在查看范围，"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

MORE FOLLOWUP

更多跟进

I think I might have finally understood what you are trying to achieve...

我想我可能终于明白你想要达到的目标了......

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

回答by bonCodigo

Here is what you can do. Put calculations on manual mode. Set the range you need to delete, instead of selecting...

这是你可以做的。将计算置于手动模式。设置您需要删除的范围，而不是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