刪除基於填充顏色索引的行

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