excel - 识别 Excel 中的重复项

Question

我正在尝试识别宏中的重复单元格。我正在尝试使用宏，以便在识别出重复项后可以提取整行。

我使用了这段代码:

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 is incredibly slow.

^ 实际上，基于此，可能应该使用 .Value2 而不是 .Value 以获得最大速度!

当然，如果我们担心的话，我们会use a variant array ，但让我们保持简单。

另外，我不知道为什么使用 xlThemeColorAccentz 和 ColorIndex

这可能有用，但对我来说不起作用 - 我只会使用 RGB

你正在对范围进行CountIf，这有点无聊。

至于检查重复项，我建议使用 dictionary为此目的。

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

新结果(相同):