Excel 在列中查找重复项

下面的代码对给定列中的重复项进行计数，并给出相同的计数，但如果有/有任何重复项，我需要在后续单元格中提及“找到重复项”，例如，如果单元格F3、F4和F15中的值相同（当我验证列“F”时，已存在列“G”所需的空白列）然后对其进行排序，并在单元格G3、G4和G15中找到“重复项”

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

输出应该是这样的：-（粗体字体是我做的，只是为了清楚地理解它不是必需的）

此代码将生成“找到重复项”

对于排序，您可以自己尝试这个，如果您不能理解代码是如何工作的，请带着问题回来。问题应保留在单一问题上。

此代码将在“F”列任何单元格的右侧（即“G”列）的单元格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

另一种选择是使用字典（首先添加对Microsoft脚本运行时的引用），该字典存储唯一值及其范围。当您沿着范围向下移动时，将填充字典，如果已经存在值，则对于原始范围和所有后续事件，记录“找到重复项”

工具>参考

在代码末尾还原：

Application.ScreenUpdating = False
Application.Calculation = xlManual

Application.Calculation = xlAutomatic
Application.ScreenUpdating = True

---

快速搜索

使用数据字段数组而不是范围循环，这是一种巧妙的嵌套搜索方法，例如字典方法可以加快搜索速度。我添加了一个

计时器

来检查所需的时间（比其他示例快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

---

尝试这样的

Range（“G”和count）

而不是

Range（count，“G”）

。提到你的错误是什么以及从哪里得到的。范围（“G”&count）它不提供任何类型的错误，但也不提供任何输出。@JonSmith-你对所需内容的描述和你提供的代码是在做两件完全不同的事情。是否要在删除重复项后列出“找到重复项”？在这种情况下，前后图片将非常有用。使用

单元格（count，“G”）

（推荐）或

单元格（count，7）

或

范围（“G”&count）

（不推荐），但绝不使用

范围（count，“G”）

。Tigregalis我也尝试了您的建议，代码运行时没有错误，但没有输出：-（它非常有效，但需要花费大量时间，有没有办法减少这一时间，因为我有数百万的此类数据。@JonSmith-“数百万的数据”-最好事先知道：）如果上面的答案太慢或不起作用，请告诉我。我有另一个想法，然后是他的。如果你的“数据[是]在数以百万计的人中，也许你应该考虑使用一个数据库。Excel会很难处理这么多的数据，不管你用了多少谢谢。脚本。字典法工作得很好。

Application.Calculation = xlAutomatic
Application.ScreenUpdating = True

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