Question

我有以下代码来查找重复值，这非常有效，但我的首选是使用相同的过程，而不使用连接填充单元格。请有人帮忙吗？

Sub Unique_vals()

    Dim rng, lastr, cel As Range, rng1 As Range
    Set lastr = Range("C1048576").End(xlUp).Offset(0, 8)
    Set rng = Range("K12", lastr)
    Set rng1 = Range("K13", lastr)

    If Range("k12").Address = lastr.Address Then 
        Exit Sub

    'populates cells with offset value
    For Each cel In rng

        cel.Value = cel.Offset(0, -8) & cel.Offset(0, -7) & cel.Offset(0, -6) & cel.Offset(0, -5) & cel.Offset(0, -4)

    Next cel

    'from k13 down this check if there is a match above
    For Each cel In rng1

        If Application.WorksheetFunction.CountIf(Range("K12", cel.Offset(-1, 0)), cel) Then 
           cel.Offset(0, 1).Value = "Duplicate"

    Next cel

End Sub

Answer 1

我们也可以在excel中通过以下语句找到值。

主页 - ＆gt;条件格式 - ＆gt;突出显示单元格规则 - ＆gt;重复值

Answer 2

Dictionary对象最适合此任务。下面是使用字典类型对象的代码，用于检查项目是否已存在。

Sub Unique_vals()
    Const FIRST_ROW As Long = 12
    Dim wks As Excel.Worksheet
    Dim lastRow As Long
    Dim dict As Object
    Dim rng As Excel.Range
    Dim cell As Excel.Range
    Dim value As String
    '-------------------------------------------------------------------------------


    'Initialize dictionary.
    Set dict = VBA.CreateObject("Scripting.Dictionary")


    Set wks = Excel.ActiveSheet
    With wks
        lastRow = .Cells(.Rows.Count, 3).End(xlUp).Row
        If lastRow <= FIRST_ROW Then Exit Sub
        Set rng = .Range(.Cells(FIRST_ROW, 11), .Cells(lastRow, 11))   '<--- 11 is index of column K.
    End With



    For Each cell In rng.Cells
        With cell
            value = .Offset(0, -8) & .Offset(0, -7) & .Offset(0, -6) & .Offset(0, -5) & .Offset(0, -4)

            'Check if there is already item with such key in dictionary [dict].
            If dict.exists(value) Then
                'Duplicate
                cell.Offset(0, 1).value = "Duplicate"
            Else
                'Unique value, add it to the dictionary.
                Call dict.Add(value, 0)
            End If

        End With
    Next cell

End Sub

Answer 3

我对您的代码做了一些小修改。如果不行，请告诉我有什么问题。试试这个：

Sub Unique_vals()

    Dim lastRange, cell As Range

    Set lastRange = Range("C1048576").End(xlUp).Offset(0, 8)

    If Range("K12").Address = lastRange.Address Then
        Exit Sub
    End If

    'populates cells with offset value
    For Each cell In Range("K12", lastRange)

        cell.Value = cell.Offset(0, -8) & cell.Offset(0, -7) & cell.Offset(0, -6) & cell.Offset(0, -5) & cell.Offset(0, -4)

    Next cell

    'from K13 down this check if there is a match above
    For Each cell In Range("K13", lastRange)

        If Application.WorksheetFunction.CountIf(Range("K12", cell.Offset(-1, 0)), cell) Then

           cell.Offset(0, 1).Value = "Duplicate"

        End If

    Next cell

End Sub

我已经测试了我的代码。它适用于我。

查找重复项的替代方法

3 个答案: