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

根据填充颜色索引删除行

2 个答案: