根据填充颜色索引删除行

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

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

编辑 ：如果你正在看范围"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