Excel VBA删除重复项保持定位

有人能帮我删除多列多行中所有重复条目的代码吗。任何具有重复值的单元格我都希望为空，但我不希望删除该单元格并像“删除重复项”按钮那样上移所有行。我希望使用与条件格式完全相同的代码来突出显示单元格，但我希望将值改为“”

我正在尝试编辑录制的宏，例如：

Columns("I:R").Select
    selection.FormatConditions.AddUniqueValues
    selection.FormatConditions(1).DupeUnique = xlDuplicate
    selection.FormatConditions(1).Value = ""

---

但我不确定自己是否走上了正确的道路

从底部开始，向顶部努力。取单元格值的十列条件值，同时将每个循环检查的行缩短1

Sub clearDupes()
    Dim rw As Long

    With Worksheets("Sheet1")
        If .AutoFilterMode Then .AutoFilterMode = False
        With Intersect(.Range("I:R"), .UsedRange)
            .Cells.Interior.Pattern = xlNone
            For rw = .Rows.Count To 2 Step -1
                With .Resize(rw, .Columns.Count)  'if clear both then remove this
                    If Application.CountIfs(.Columns(1), .Cells(rw, 1), .Columns(2), .Cells(rw, 2), _
                                            .Columns(3), .Cells(rw, 3), .Columns(4), .Cells(rw, 4), _
                                            .Columns(5), .Cells(rw, 5), .Columns(6), .Cells(rw, 6), _
                                            .Columns(7), .Cells(rw, 7), .Columns(8), .Cells(rw, 8), _
                                            .Columns(9), .Cells(rw, 9), .Columns(10), .Cells(rw, 10)) > 1 Then

                        'test with this
                        .Rows(rw).Cells.Interior.Color = vbRed
                        'clear values with this once it has been debugged
                        '.Rows(rw).Cells.ClearContents
                    End If
                End With  'if clear both then remove this
            Next rw
        End With
        If .AutoFilterMode Then .AutoFilterMode = False
    End With
End Sub

---

我在其中留下了一些代码，只标记了可能的重复项。当您对结果满意时，将其更改为实际清除单元格内容的注释代码。

使用条件格式突出显示重复项，然后使用循环选择将值更改为“”。 此代码将允许保留一个值。（如果您有两次25，此代码将保留一个25）

选项显式
副杜普雷（）
Application.ScreenUpdating=False
低雷诺数范围
Dim dup As范围
列（“I:R”）.FormatConditions.AddUniqueValues
列（“I:R”）.FormatConditions（1）。DupeUnique=xlDuplicate
列（“I:R”）.FormatConditions（1）。Font.Color=RGB（255，255，0）
对于列（“I:R”）单元格中的每个rn
如果rn为“”，则
如果rn.DisplayFormat.Font.Color=RGB（255，255，0），则
如果dup不算什么，那么
设置dup=rn
其他的
设置dup=联合（dup，rn）
如果结束
如果结束
如果结束
下一个
dup.ClearContents
列（“I:R”）。FormatConditions（1）。StopIfTrue=False
列（“I:R”）.FormatConditions.Delete
Application.ScreenUpdating=True
端接头

使用两组嵌套循环，我检查该范围内的每个单元格两次，一次查看是否重复并标记它，第二次删除该值（确保删除所有重复项，并且不保留每个重复项的一个实例）

我确信这是一种低效的方法，但它很有效，希望能帮助其他同舟共济的人

Private Sub CommandButton1_Click()
Dim Row As Integer
Dim Column As Integer

Row = 100
Column = 10

'loop through identifying the duplicated by setting colour to blue
For i = 1 To Row 'loops each row up to row count
    For j = 1 To Column 'loops every column in each cell
        If Application.CountIf(Range(Cells(4, 1), Cells(Row, Column)), Cells(i, j)) > 1 Then 'check each cell against entire range to see if it occurs more than once
            Cells(i, j).Interior.Color = vbBlue 'if it does sets it to blue
        End If
    Next j
Next i

'loop through a second time removing the values in blue (duplicate) cells
For i = 1 To Row 'loops each row up to row count
    For j = 1 To Column 'loops every column in each cell
        If Cells(i, j).Interior.Color = vbBlue Then 'checks if cell is blue (i.e duplicate from last time)
            Cells(i, j) = "" 'sets it to blank
            Cells(i, j).Interior.Color = xlNone 'changes colour back to no fill
        End If
    Next j
Next i

End Sub

---

谢谢你的回复，凯山。不幸的是，如果一个单元格重复，那么我不希望它全部存在（甚至一次也不存在）。如果高亮显示一个数组并应用条件格式高亮显示重复项，则它会标记我希望转换为空白的所有单元格，但如果随后循环并删除这些单元格，则最后出现的重复项将不再显示为重复项（因为所有其他出现的重复项都将被删除，但随后）。这有意义吗？我很抱歉回复晚了，因为我离开了几天。我已经根据您的要求编辑了答案。谢谢。我希望删除每一个出现多次的单元格。（不一定是整行）。我只需要留下唯一的单元格值。（也就是说，如果一个单元格重复，那么在运行代码后我根本不想要它，甚至一次也不想要）。但是我喜欢乡村。我也许可以在每个重复的细胞上循环着色，然后再循环移除着色细胞。我想没有更简单的内置“复制”方法，这听起来并不困难。只需删除正在检查的范围的大小调整。fwiw，这实际上不是a的工作原理，但我想它更接近于重复的CF规则。

Private Sub CommandButton1_Click()
Dim Row As Integer
Dim Column As Integer

Row = 100
Column = 10

'loop through identifying the duplicated by setting colour to blue
For i = 1 To Row 'loops each row up to row count
    For j = 1 To Column 'loops every column in each cell
        If Application.CountIf(Range(Cells(4, 1), Cells(Row, Column)), Cells(i, j)) > 1 Then 'check each cell against entire range to see if it occurs more than once
            Cells(i, j).Interior.Color = vbBlue 'if it does sets it to blue
        End If
    Next j
Next i

'loop through a second time removing the values in blue (duplicate) cells
For i = 1 To Row 'loops each row up to row count
    For j = 1 To Column 'loops every column in each cell
        If Cells(i, j).Interior.Color = vbBlue Then 'checks if cell is blue (i.e duplicate from last time)
            Cells(i, j) = "" 'sets it to blank
            Cells(i, j).Interior.Color = xlNone 'changes colour back to no fill
        End If
    Next j
Next i

End Sub