根据颜色索引删除单元格

Question

我有数据显示两个列表之间的重复。我正在尝试删除有重复的单元格，只显示那些不匹配的单元格。因此，我不能删除行，但只能删除单元格来实现我正在尝试的。我尝试了内置功能的查找复制，但它无法正常工作。

这就是我的工作表：

我找到了这段代码here：

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的所有单元格For。如果还需要检查字体，可以修改删除单元格之前必须满足的条件。

请注意，当您使用循环从一个范围中删除单元格或行时，您需要从底部开始并逐步前进，以防止在删除后找出您所在的位置。

您可以将此项用于所需的任意数量的列。将DeleteDupesForAllColumns中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 循环的上限范围设置为您要处理的最后一列。

DeleteDupesForAllColumns()

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

编辑：检测基于条件格式的单元格中的颜色非常困难。如果这是设置单元格中颜色的方式，则可以使用以下子项将重复单元格的内部颜色设置为可以使用上面的代码检测到的颜色。先运行此操作，然后运行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 。

{{1}}

您可能也对highlighting each set of duplicates in a range with a different color感兴趣。