如何使用vba在excel的列中查找重复项，然后弹出一个Msgbox？答案

【问题标题】：How to find duplicates in a column in excel using vba and then popup a Msgbox?如何使用vba在excel的列中查找重复项，然后弹出一个Msgbox？
【发布时间】：2019-07-27 00:25:56
【问题描述】：

想要在 excel 的列中查找重复项，并希望在找到 1 个重复项时弹出一个 msgbox，如果找到多个重复项，它不应该继续弹出消息。

另外，如果我可以使用两个列单元格值并一起使用它来查找重复项，这也会很有帮助。

  Sub ColumnDuplicates()
    Dim lastRow As Long
    Dim matchFoundIndex As Long
    Dim iCntr As Long
    lastRow = Range("A65000").End(xlUp).Row

    For iCntr = 1 To lastRow
    If Cells(iCntr, 1) <> "" Then
        matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range("A1:A" & lastRow), 0)
        If iCntr <> matchFoundIndex Then
            MsgBox ("There are duplicates in Column A")
        End If
    End If
    Next
    MsgBox ("No Duplicates in Column A")
End Sub

期望打印消息说 A 列有重复项或没有重复项

【问题讨论】：

不是直接重复，但this answer 谈论在列中查找重复
@calestini：我喜欢 OP 在该链接中采用的方法.RemoveDuplicates。我会继续采用这种方法，因为它不涉及任何循环。但是，我将使用临时工作表，而不是在同一张工作表中使用列。
但这也取决于用户是否使用 Excel 2007+... 查看"A65000"，用户可能仍在使用 Excel 2003。
您使用的是哪个 Excel 版本？
@MathieuGuindon 我同意你的看法 :) 我已经在 post

标签： excel vba

【解决方案1】：

EVALUATE的用法呢？

Public Sub Test()

With ThisWorkbook.Sheets("Sheet1")
    lr = .Cells(.Rows.Count, "A").End(xlUp).Row
    If .Evaluate("=Max(countif(A1:A" & lr & ",A1:A" & lr & "))") > 1 Then
        MsgBox "Duplicates!"
    Else
        MsgBox "No Duplicates!"
    End If
End With

End Sub

或者，参数化：

Public Sub Test(ByVal sheet As Worksheet, ByVal columnHeading As String)

With sheet
    lr = .Cells(.Rows.Count, columnHeading).End(xlUp).Row
    If .Evaluate("=Max(countif(" & columnHeading & "1:" & columnHeading & lr & "," & columnHeading & "1:" & columnHeading & lr & "))") > 1 Then
        MsgBox "Duplicates!"
    Else
        MsgBox "No Duplicates!"
    End If
End With

End Sub

现在你可以像这样调用它：

Test Sheet1, "A" ' find dupes in ThisWorkbook/Sheet1 in column A
Test Sheet2, "B" ' find dupes in ThisWorkbook/Sheet2 in column B
Test ActiveWorkbook.Worksheets("SomeSheet"), "Z" ' find dupes in "SomeSheet" worksheet of whatever workbook is currently active, in column Z

【讨论】：

++ 漂亮...不过我看到了一个问题...随着行数的增加，数组公式会变慢 :) 对于 160k 行，您的代码运行速度非常慢...
非常感谢您的回答！
我认为您可以使用With 块工作表限定Evaluate，以便Evaluate 在该工作表的上下文中运行（即调用Worksheet.Evaluate 而不是[Application.]Evaluate），这将允许安全地将Sheet1!A1:A 更改为简单的A1:A。虽然不是Evaluate 的粉丝。
@SiddharthRout，我应该考虑一下，该喝咖啡了！
这不是您的实际问题。当很多人已经根据原始问题@Zubair 为您提供解决方案时，请不要中途更改问题：)

【解决方案2】：

将您的值放入字典中

Sub ColumnDuplicates()
Dim lastRow As Long
Dim matchFoundIndex As Long
Dim iCntr As Long

lastRow = Range("A65000").End(xlUp).Row
Set oDictionary = CreateObject("Scripting.Dictionary")
For iCntr = 1 To lastRow
    If Cells(iCntr, 1) <> "" Then
        If oDictionary.Exists(Cells(iCntr, 1).Value) Then
            MsgBox ("There are duplicates in Column A")
            Exit Sub
        Else 
            oDictionary.Add Cells(iCntr, 1).Value, Cells(iCntr, 1).Value
        End If
    End If
Next
MsgBox ("No Duplicates in Column A")
End Sub

【讨论】：

感谢蒂姆的回答。但是如果 A 列中有重复项，则它不起作用
@Zubair 关心详细说明“不起作用”是什么意思？根据定义，Dictionary 键是唯一的。
@MathieuGuindon 当您在 A 列的多行中放置相同的值时，它不会检测到重复项。
@Zubair 再试一次，这次存储值而不是单元格对象本身。在这里工作。
FWIW 这个被低估的答案是唯一一个在已知存在重复项时立即退出的答案，而无需遍历整个行集；在第 12 行重复的一百万行将只处理 12 行； Evaluate/WorksheetFunction 解遍历整个集合然后判断是否有骗子。

【解决方案3】：

如果您有 Excel 2007+，那么这会更快。此代码在 1 秒内运行 200k 行

Sub Sample()
    Debug.Print Now

    Dim ws As Worksheet
    Dim wsTemp As Worksheet

    Set ws = Sheet1

    Set wsTemp = ThisWorkbook.Sheets.Add

    ws.Columns(1).Copy wsTemp.Columns(1)

    wsTemp.Columns(1).RemoveDuplicates Columns:=1, Header:=xlNo

    If Application.WorksheetFunction.CountA(ws.Columns(1)) <> _
       Application.WorksheetFunction.CountA(wsTemp.Columns(1)) Then
        Debug.Print "There are duplicates in Col A"
    Else
        Debug.Print "duplicates found in Col A"
    End If

    Application.DisplayAlerts = False
    wsTemp.Delete
    Application.DisplayAlerts = True

    Debug.Print Now
End Sub

我使用下面的代码在 Col A 中生成了 20 万条记录

Sub GenerateSampleData()
    Range("A1:A200000").Formula = "=Row()"
    Range("A1:A200000").Value = Range("A1:A200000").Value
    Range("A10000:A20000").Value = Range("A20000:A30000").Value
End Sub

代码执行

【讨论】：