excel - 查找重复项和重命名主/子

Question

我有一些代码正在查找重复项并突出显示单元格:

Private Sub cmdDups_Click()
Dim Rng As Range
Dim cel As Range

Set Rng = ThisWorkbook.Worksheets("data").Range(Range("C1"), ThisWorkbook.Worksheets("data").Range("C" & Rows.Count).End(xlUp))
    For Each cel In Rng
        If WorksheetFunction.CountIf(Rng, cel.Value) > 1 Then
            cel.Interior.ColorIndex = 3
        End If
    Next cel
End Sub

但是，它令人困惑，因为它只是突出显示了所有内容。我将如何为它们添加一个子修复，例如 MASTER 和 CHILD。法师依据什么时候第一个找到，而子则为后事。

那可能吗？

Answer 1

我会避免过于频繁地调用工作表。它通常更喜欢通过内存工作。以下内容可能看起来相当广泛，但我尝试写一些评论以使其清楚:

Sub Test()

Dim lr As Long, x As Long, arr As Variant
Dim rng1 As Range, rng2 As Range
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")

With ThisWorkbook.Worksheets("data")

    'Find last used row in column C and prepare array to read through memory
    lr = .Cells(.Rows.Count, 3).End(xlUp).Row
    Set rng1 = .Range("C1:C" & lr)
    arr = rng1.Value

    'Loop over array and create a range object through Union and check against dictionary
    For x = LBound(arr) To UBound(arr)
        If WorksheetFunction.CountIf(rng, arr(x, 1)) > 1 Then
            If Not rng2 Is Nothing Then
                Set rng2 = Union(rng2, .Cells(x, 3))
            Else
                Set rng2 = .Cells(x, 3)
            End If
            If dict.exists(arr(x, 1)) Then
                arr(x, 1) = "CHILD " & arr(x, 1)
            Else
                dict(arr(x, 1)) = 1
                arr(x, 1) = "MASTER " & arr(x, 1)
            End If
        End If
    Next

    'Read back array and change cells colors
    rng2.Interior.ColorIndex = 3
    rng1.Value = arr

End With

End Sub

前:



后: