根据填充颜色索引删除行 [英] Delete row based on fill color index

问题描述

我正在尝试删除所有包含范围 A7：AI300 的行包含一个带有黄色填充的单元格（颜色索引6）我有一些代码将删除所有包含颜色的行，但我遇到的问题是它正在尝试运行整个工作表的代码，并将冻结我的工作簿。我试图插入一个范围来加快计算。任何人都可以告诉我如何插入范围，使其工作

  Sub deleterow（）
 Dim cell As Range 
对于每个单元格在选择
如果cell.Interior.ColorIndex = 6然后
 cell.EntireRow.Delete 
结束如果
下一个单元格
 End Sub 
  

解决方案

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

编辑：如果您正在查看范围A7：A300然后使用此代码

  Sub deleterow（）
 Dim cell As Range，DelRange As Range 
 
 For This cell In ThisWorkbook.Sheets（Sheet1）。Range（A7：A300）
如果cell.Interior.ColorIndex = 6然后
如果DelRange不是，然后
设置DelRange =单元
 Else 
设置DelRange = Union（DelRange，cell）
如果
结束如果
下一个单元格
 
如果不是DelRange是没有，然后DelRange.EntireRow.Delete 
 End Sub 
  

如果您正在查看范围A7：AI300那么我猜这是什么你想要的。

  Sub deleterow（）
 Dim cell As Range，DelRange As Range 
 
对于每个单元格在ThisWorkbook.Sheets（Sheet1）。范围（A7：AI300）
如果cell.Interior.ColorIndex = 6然后
如果DelRange不是然后
设置DelRange =单元格
 Else 
 Set DelRange = Union（DelRange，cell）
 End If 
 End If 
下一个单元格
 
如果Not DelRange不是然后DelRange.Delete 
 End Sub 
  

MORE FOLLOWUP

我想我可能终于明白你想要实现什么...

  Sub deleterow（）
 Dim i As Long，j As Long 
 Dim delRange As Range 
 
 With ThisWorkbook.Sheets（Sheet1）
 For i = 7到300'<〜〜行7到300 
对于j = 1到35 <〜〜Col A到AI 
如果.Cells（i，j）.Interior.ColorIndex = 6 then 
如果delRange不是，然后
设置delRange = .Cell s（i，j）
 Else 
设置delRange = Union（delRange，.Cells（i，j））
 End If 
退出
结束If 
下一个j 
下一个i 
结束
 
如果不是delRange是没有，然后delRange.EntireRow.Delete 
 End Sub 
  

I am trying to delete all rows with in the range of A7:AI300 that 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

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

解决方案

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

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.

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

这篇关于根据填充颜色索引删除行的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！