根据颜色索引删除单元格

我有数据显示我在两个列表之间重复。 我试图删除重复的单元格，只显示那些不匹配的单元格。 因此，我不能删除行，但只能删除单元格，以实现我想要的。 我尝试了在函数中build立的查找复制，但它不工作。

这是我的工作表的样子：

我在这里find了这个代码：

Sub RowDelete() Application.ScreenUpdating = False Dim myRow As Integer Dim myCol As Integer Dim Counter As Integer Counter = 0 myCol = 1 rBegin = 1 rEnd = 100 For myRow = rEnd To rBegin Step -1 Application.StatusBar = Counter & " rows deleted." If Cells(myRow, myCol).Interior.ColorIndex = xlNone Then Cells(myRow, myCol).EntireRow.Delete Counter = Counter + 1 End If Next myRow Application.StatusBar = False Application.ScreenUpdating = True x = MsgBox(Counter & " rows deleted.", vbOKOnly, "Rows Deleted") End Sub 

我需要帮助改变它只删除单元格，而不是具有这种格式的行：

 With formatCols.FormatConditions(1).Font .Color = -16383844 .TintAndShade = 0 End With With formatCols.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 13551615 .TintAndShade = 0 End With 

Answer 1

下面的子将删除dupeColumn任何单元格，如果它们具有.Interior.Color = 13551615 。 如果您还需要检查字体，则可以修改单元格删除前必须满足的条件。

请注意，当您使用循环删除某个范围内的单元格或行时，您需要从底部开始并按照自己的方式进行操作，以防止在删除之后确定您的位置。

您可以使用这个为你想要的列数。 将DeleteDupesForAllColumns中的For循环的上限范围设置为您要处理的最后一列。

 Sub DeleteDupesForAllColumns() Dim dupeColumn As Long Application.ScreenUpdating = False For dupeColumn = 1 To 5 Call DeleteDupesBasedOnColor(dupeColumn) Next dupeColumn Application.ScreenUpdating = True End Sub Sub DeleteDupesBasedOnColor(dupeColumn As Long) Dim ws As Worksheet Dim cell As Range Dim firstRow As Long Dim lastRow As Long Dim i As Long Set ws = ThisWorkbook.Sheets("Sheet3") firstRow = 1 lastRow = ws.Cells(ws.Rows.Count, dupeColumn).End(xlUp).Row For i = lastRow To firstRow Step -1 Set cell = ws.Cells(i, dupeColumn) If cell.Interior.Color = 13551615 Then cell.Delete shift:=xlUp End If Next i End Sub 

注意：确保将variables设置为要使用的对象。 （例如，将ws设置为具有重复列的表单，并将dupeColumn设置为正确的列）

编辑：这是很难检测基于条件格式的单元格中的颜色。 如果这是如何设置单元格中的颜色，则可以使用以下子设置重复的单元格的内部颜色，然后使用上面的代码进行检测。 首先运行它，然后运行DeleteDupesForAllColumns() 。

 Sub ColorDupeCells() Dim ws As Worksheet Dim cell As Range Dim dupeRange As Range Dim dupeColor As Long Set ws = ThisWorkbook.Sheets("Sheet3") Set dupeRange = ws.Range("A2:K100") dupeRange.Interior.ColorIndex = xlNone dupeColor = 13551615 Application.ScreenUpdating = False For Each cell In dupeRange If Application.WorksheetFunction.CountIf(dupeRange, cell) > 1 Then cell.Interior.Color = dupeColor End If Next Application.ScreenUpdating = True End Sub 

您也可能有兴趣突出显示不同颜色范围内的每个副本 。