使用 Excel VBA 从随机单元格中删除重复项答案

【问题标题】：Remove Duplicates from Random Cells using Excel VBA使用 Excel VBA 从随机单元格中删除重复项
【发布时间】：2015-02-01 15:13:22
【问题描述】：

我有一个 Excel 表，其中我在不同的单元格中重复了值。但这里的问题是所有这些单元格都不相邻。我将从工作表中手动随机选择这些单元格并希望删除重复项。

在下面的屏幕截图中，我选择了值为“test”的随机单元格。我想从选定的单元格中删除重复项。

道歉：添加可能的场景。只需要第一次出现任何重复的单元格。删除剩余的事件。这意味着它应该给出 A1=TEST & B6=WEST。应删除所有其他单元格值。

【问题讨论】：

该选择中的 ActiveCell 是 C12。您希望 C12（或其他单元格）保留为 Test 还是全部删除？
@Jeeped - 除选定的活动单元（C12）外，删除所有这些。谢谢。
嗯回复：您的编辑。 “第一次出现”是什么意思？例如，如果新（第一个）图像中突出显示的单元格（A1）不存在，那将是您的“第一次出现”？是 C2（按行）还是 A5（按列）？
显示的结果中不应该有“West”吗？我希望如此，因为这就是我编辑的答案所假设的。
@Doug Glancy - 非常好的解决方案 Doug。我认为第二张图片只是指原始 Q，并不意味着是编辑产生的结果。最好是删掉？是否记录了“For Each”评估此类范围/选择的顺序？

标签： vba excel

【解决方案1】：

假设您已经进行了随机选择：

Sub dural()
    Dim v As Variant, r As Range
    v = ActiveCell.Text
    addy = ActiveCell.Address
    For Each r In Selection
        If Not addy = r.Address Then
            If r.Value = v Then
                r.ClearContents
            End If
        End If
    Next r
End Sub

【讨论】：

【解决方案2】：

只是为了好玩，这里有一个非循环版本。它确实清除了 ActiveCell 的值，然后重新分配它，这在我有限的测试中适用于所有情况：

Sub RemoveAllSelectionCellsExceptActiveCell()
Dim ActiveCellValue As Variant

ActiveCellValue = ActiveCell.Formula
Selection.Clear
ActiveCell.Formula = ActiveCellValue
End Sub

编辑：回复您编辑的问题

这取决于adding a duplicate to a collection generates an error.如果发生这种情况，相关单元格将添加到要删除的单元格范围中。请注意，它会将“=2”的单元格视为与“2”的单元格不同：

Sub RemoveAllSelectionCellsExceptActiveCell2()

Dim cell As Excel.Range
Dim collDupes As Collection
Dim DupeCells As Excel.Range

Set collDupes = New Collection
For Each cell In Selection.Cells
    On Error Resume Next
    collDupes.Add cell.Formula, cell.Formula
    If Err.Number <> 0 Then
        If DupeCells Is Nothing Then
            Set DupeCells = cell
        Else
            Set DupeCells = Union(DupeCells, cell)
        End If
    End If
    On Error GoTo 0
Next cell
DupeCells.Clear
End Sub

【讨论】：

【解决方案3】：

还有一个……

如果您想清除单元格的内容和格式，并将光标留在ActiveCell 中而不突出显示选定的单元格。

请注意，当您进行选择时，将是最后访问的单元格，即 ActiveCell，其内容将保留并保持选中状态。

Option Explicit
Sub remSelDup()
Dim ac As Range, c As Range
Set ac = ActiveCell
    For Each c In Selection
        If c = ac And c.Address <> ac.Address Then
           c.Clear
        End If
    Next c
ac.Select
End Sub

【讨论】：

【解决方案4】：

这个网站上应该有很多 Find/FindNext 示例，但这里还有一个。

Dim fnd As Range, fcl As Range, searchTerm As Variant

With ActiveSheet
    Set fcl = ActiveCell
    searchTerm = fcl.Value
    Set fnd = .Cells.Find(What:=searchTerm, After:=fcl, LookIn:=xlValues, LookAt:= _
        xlWhole, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    Do While fcl.Address <> fnd.Address
        fnd.ClearContents
        Set fnd = .Cells.FindNext(After:=fcl)
    Loop
End With

【讨论】：