在Excel中识别重复项

我试图在macros中识别重复的单元格。 我试图使用macros，所以我可以提取整个行一旦确定重复。

我用这个代码：

Sub MarkDuplicates() Dim iWarnColor As Integer Dim rng As Range Dim rngCell As Variant Set rng = Sheets("AllAccounts (12-05-2017)").Range("D1:D1613") iWarnColor = xlThemeColorAccentz For Each rngCell In rng.Cells vVal = rngCell.Text If (WorksheetFunction.CountIf(rng, vVal) = 1) Then rngCell.Interior.Pattern = xlNone Else rngCell.Interior.ColorIndex = iWarnColor End If Next rngCell End Sub 

但它只识别空单元格。 此刻，我只是想识别重复的文本，稍后我会提取它们。

你能帮我做吗？

Answer 1

你不需要把rng.Cells – .Cells隐含 – 只要使用rng

（^这是语义 – 做任何你想要的）

而不是检查rngCell.Text – 尝试rngCell.Value 。

.Text 速度非常慢。

^真的，基于此，应该可能使用.Value2而不是.Value最大speeeeeed！

当然，如果我们是这样的话，我们会使用一个变体数组 ，但让我们保持简单。

另外，idk为什么使用xlThemeColorAccentz和ColorIndex

这可能工作，但它不适合我 – 我只会使用RGB

你正在做一个CountIf ，如果这个范围就是这样的CountIf 。

至于检查重复，我会build议使用字典为此目的。

 Dim dict As Object Set dict = CreateObject("Scripting.Dictionary") 

你的代码变成：

 Sub MarkDuplicates() Dim iWarnColor As Long Dim rng As Range Dim rngCell As Variant Dim dict As Object Set dict = CreateObject("Scripting.Dictionary") Set rng = Sheets("AllAccounts (12-05-2017)").Range("D1:D1613") rng.Interior.ColorIndex = xlNone 'Optionally clear all coloring iWarnColor = RGB(230, 180, 180) 'Red For Each rngCell In rng If rngCell.Value <> "" Then 'Ignore blank cells If Not dict.Exists(rngCell.Value) Then dict.Add rngCell.Value, rngCell.Row 'Store the row if we want Else rngCell.Interior.Color = iWarnColor 'Optionally color the original cell: 'Sheets("AllAccounts (12-05-2017)").Cells(dict(rngCell.Value), "D").Interior.Color = RGB(180, 230, 180) End If End If Next rngCell End Sub 

带有可选颜色的结果：

编辑（不使用字典）：

所以，你正在使用一个mac – 哦，哦。

我之前没有提到它，但是可以使用条件格式来解决这个问题。

无论如何，我们只是使用一个集合。

一个集合与字典很像，但是我们通常需要循环来确定一个特定的键/值对是否存在。

我们可以通过尝试获取一个不存在的键的值来捕获错误 – 我添加了一个函数来简化这个过程。

 Sub MarkDuplicates() Dim iWarnColor As Long Dim rng As Range Dim rngCell As Variant Dim Col As New Collection Set rng = Sheets("AllAccounts (12-05-2017)").Range("D1:D1613") rng.Interior.ColorIndex = xlNone iWarnColor = RGB(230, 180, 180) For Each rngCell In rng If rngCell.Value <> "" Then 'Ignore blank cells If Not IsInCollection(Col, rngCell.Value2) Then Col.Add rngCell.Row, Key:=rngCell.Value2 Else rngCell.Interior.Color = iWarnColor 'Optionally color the original cell Sheets("AllAccounts (12-05-2017)").Cells(Col(rngCell.Value2), "D").Interior.Color = RGB(180, 230, 180) End If End If Next rngCell End Sub Function IsInCollection(Col As Collection, Val As Variant) As Boolean On Error Resume Next Debug.Print (Col(Val)) IsInCollection = (Err.Number = 0) On Error GoTo 0 End Function 

新成绩（同）：