Question

下面的代码计算给定列中的重复项，并给出相同的计数，但如果有/有任何重复项，我需要＆＃34;重复发现＆＃34;在后续单元格中，例如，如果单元格F3，F4和F15中的值相同（需要空白列，即列＃34; G＆＃34;已经存在，因为我正在验证列＆＃34; F＆＃34;）然后它应该排序并在单元格G3，G4和G15＆＃34;重复发现＆＃34;应该在那里。

Dim helperCol As Range
Dim count As Long

With Worksheets("Sheet1")
    Set helperCol = .UsedRange.Resize(, 1).Offset(, .UsedRange.Columns.count)
    With .Range("F1", .Cells(.Rows.count, 6).End(xlUp))
        helperCol.Value = .Value
        helperCol.RemoveDuplicates Columns:=1, Header:=xlYes
        count = .SpecialCells(xlCellTypeConstants).count - helperCol.SpecialCells(xlCellTypeConstants).count
    End With
    helperCol.ClearContents
End With

If count >= 1 Then
    Range(count, "G") =   " Duplicate/s found"
End If

输出应该如下所示： - （粗体字由我完成只是为了清楚地理解它不是必需的）

Answer 1

此代码将生成＆＃34; Duplicate Found＆＃34;在列＃34; F＆＃34;中的任何单元格的右侧（即列＃34; G＆＃34;）中的单元格1中有重复。

Option Explicit

Sub Test()

    Dim CEL As Range, RANG As Range

    With Worksheets("Sheet1")

        ' Build a range (RANG) between cell F2 and the last cell in column F
        Set RANG = Range(.Cells(2, "F"), .Cells(.Rows.Count, "F").End(xlUp))

    End With

    ' For each cell (CEL) in this range (RANG)
    For Each CEL In RANG

        ' If the count of CEL in RANG is greater than 1, then set the value of the cell 1 across to the right of CEL (i.e. column G) as "Duplicate Found"
        If Application.WorksheetFunction.CountIf(RANG, CEL.Value) > 1 Then CEL.Offset(, 1).Value = "Duplicate Found"

    Next CEL

End Sub

另一种选择是使用Dictionary（首先添加对Microsoft Scripting Runtime的引用），它存储唯一值及其范围。当你向下移动范围时，你填写字典，如果一个值已经存在，那么对于原始范围和所有后续事件，记录＆＃34;复制找到＆＃34;。

工具＆gt;参考

Sub Test2()

    Dim CEL As Range, RANG As Range
    Dim dict As New Scripting.Dictionary

    With Worksheets("Sheet1")

        ' Build a range (RANG) between cell F2 and the last cell in column F
        Set RANG = Range(.Cells(2, "F"), .Cells(.Rows.Count, "F").End(xlUp))

    End With

    ' For each cell (CEL) in this range (RANG)
    For Each CEL In RANG

        If CEL.Value <> "" Then ' ignore blank cells

            If Not dict.Exists(CEL.Value) Then ' if the value hasn't been seen yet
                dict.Add CEL.Value, CEL ' add the value and first-occurrence-of-value-cell to the dictionary
            Else ' if the value has already been seen
                CEL.Offset(, 1).Value = "Duplicate Found" ' set the value of the cell 1 across to the right of CEL (i.e. column G) as "Duplicate Found"
                dict(CEL.Value).Offset(, 1).Value = "Duplicate Found" ' set the value of the cell 1 across to the right of first-occurrence-of-value-cell (i.e. column G) as "Duplicate Found"
            End If

        End If

    Next CEL

    Set dict = Nothing

End Sub

理论上，这应该更快，因为它在整个范围内的迭代次数更少; Countif函数检查与每个细胞匹配的整个范围，即1百万个细胞×1百万个细胞。但我不确定Dictionary对象有多贵。对于此方法，当您检查每个单元格时，Dictionary对象会增长，因此后续访问可能会变慢，但这仍然比再次检查每个单元格要便宜;此外，Dictionary对象只能增加与唯一值的数量一样大。

其他表现增加：

设置代码的开头：

Application.ScreenUpdating = False
Application.Calculation = xlManual

在代码末尾恢复：

Application.Calculation = xlAutomatic
Application.ScreenUpdating = True

Answer 2

此代码将生成＆＃34; Duplicate Found＆＃34;。

Option Explicit

Sub Test()

With Worksheets("Sheet1")

   Dim LastRow As Long
   LastRow = .Range("F" & .Rows.Count).End(xlUp).Row

   .Range("G2:G" & LastRow).FormulaR1C1 = "=IF(COUNTIF(RC[-1]:R[" & LastRow - 2 & "]C[-1],RC[-1])>1,""Duplicate Found"","""")"

End With


End Sub

对于排序，请自行尝试，如果您无法弄清楚代码是如何工作的，请回过头来回答问题。问题应该保留在SO上的一个问题上。

Answer 3

快速搜索

使用数据字段数组而不是范围循环，一种聪明的嵌套搜索方法，例如：加速搜索的字典方法。我添加了一个Timer来检查所需的时间（比其他示例快n倍）：

<强>代码

Public Sub FindDups()
' Site:    https://stackoverflow.com/questions/47099413/find-duplicates-in-a-column
' Purpose: mark duplicates via Array

Dim t        As Double              ' Timer
Dim v      ' As Variant             ' one based 2dim array, variant
Dim ws       As Worksheet           ' worksheet
Dim i        As Long                ' item counter
Dim j        As Long                ' item counter
Dim n        As Long                ' last row number
Dim d        As Object              ' dictionary, late binding
Set d = CreateObject("scripting.dictionary")
' stop watch
  t = Timer
' set worksheet
  Set ws = ThisWorkbook.Worksheets("Sheet1")

' get last row number in column F
  n = ws.Range("F" & ws.Rows.count).End(xlUp).Row
  ReDim v2(1 To n - 1, 1 To 1)
' create one based 2dim data field array
  v = ws.Range("F2:F" & n).Value2
' check for duplicates
  For i = 1 To n - 1
    If d.Exists(v(i, 1)) Then
             v2(i, 1) = " Duplicate/s found"
    Else
      For j = i + 1 To n - 1            ' start search for dups one row below
          If v(i, 1) = v(j, 1) Then
             v2(i, 1) = " Duplicate/s found"
             d(v(i, 1)) = v(i, 1)       ' add to dictionary
             Exit For
          End If
      Next j
    End If
  Next i
' write values back
  ws.Range("G2:G" & n).Value2 = v2
  Set d = Nothing
' Time needed
  MsgBox "Time needed: " & Format(Timer - t, "0.00 ") & " seconds."

End Sub

在列

3 个答案: