1

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

这是我的工作表的样子：http://i.imgur.com/SLlq7l6.png

我在这里找到了这段代码：

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
4

1 回答 1

2

以下子程序将删除dupeColumnif中的所有单元格.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

注意：确保将变量设置为要使用的对象。（例如，将 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

您可能还对使用不同颜色突出显示范围内的每组重复项感兴趣。

于 2013-06-24T16:06:01.703 回答