时间戳

首页 > 解决方案 > 如何使用vba在excel的列中查找重复项，然后弹出一个Msgbox？

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

问题描述

想要在 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 列有重复项或没有重复项

标签： excelvba

解决方案

使用情况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

推荐阅读