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

我有一个Excel表格，我已经在不同的单元格中重复值。 但这里的捕捉是所有那些细胞不相邻的。 我将随机从表单中手动select这些单元格，并希望删除重复项目。

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

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

Answer 1

假设你已经做了随机select：

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 

Answer 2

只是为了好玩，这里是一个非循环版本。 它消灭了ActiveCell的价值，然后重新分配它，在我有限的testing中，在所有情况下工作：

 Sub RemoveAllSelectionCellsExceptActiveCell() Dim ActiveCellValue As Variant ActiveCellValue = ActiveCell.Formula Selection.Clear ActiveCell.Formula = ActiveCellValue End Sub 

编辑：对你编辑的问题的回应

这依赖于向集合中添加副本会生成错误 。 如果发生这种情况，有问题的单元被添加到要删除的单元格范围内。 请注意，它将把“= 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 

Answer 3

而另一个…

如果要清除单元格的内容和格式，并将光标保留在ActiveCell ，而没有选定的单元格突出显示。

请注意，当你做出select时，它将是最后访问的单元格，它的内容将保持不变，并保持选中状态。

 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 

Answer 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