使用 VBA 删除重复项并提醒用户

Question

我是使用肥皂调用的重要数据，我的问题是在某些情况下我可能会得到重复的数据。

我可以使用
WS.Range("A6:O200").RemoveDuplicates Columns:=(2)

轻松删除这些数据

但是，我希望在发生这种情况时通过 MsgBox 提醒用户。目前，我正在尝试使用从此处的另一篇文章改编的一些代码来实现此功能。

Dim dict As Object

' Let Col be the column which warnDupes operates on.
Dim Col As String

Col = "B"

Set dict = CreateObject("scripting.dictionary")

dupeRow = Range(Col & Rows.Count).End(xlUp).Row

On Error Resume Next
For i = dupeRow To 1 Step -1
    If dict.Exists(UCase$(Range(Col & i).Value)) = True Then

    'range("Y" & i).EntireRow.Delete
    WS.Range("A6:O200").RemoveDuplicates Columns:=(2)

    'MsgBox ("Hmm...Seems to be a duplicate of " & Range(Col & i).Value & _
    " in Cell " & Col & i)

End If

dict.Add UCase$(Range(Col & i).Value), 1
Next

 MsgBox ("Duplicate unfullfilled requests where removed")

问题当然是，这要么显示循环中删除的每个重复值的消息，要么即使没有重复值（就像现在一样）。理想情况下，我想要的是删除重复项以完全运行，然后通过消息提醒用户。

问候 山姆

Answer 1

Dim dict As Object

' Let Col be the column which warnDupes operates on.
Dim Col As String
Dim bCount as Boolean

Col = "B"

Set dict = CreateObject("scripting.dictionary")

dupeRow = Range(Col & Rows.Count).End(xlUp).Row

On Error Resume Next
For i = dupeRow To 1 Step -1
    If dict.Exists(UCase$(Range(Col & i).Value)) = True Then

        'range("Y" & i).EntireRow.Delete
        WS.Range("A6:O200").RemoveDuplicates Columns:=(2)

        bCount = True

        'MsgBox ("Hmm...Seems to be a duplicate of " & Range(Col & i).Value & _
        " in Cell " & Col & i)

    End If

    dict.Add UCase$(Range(Col & i).Value), 1
Next

If bCount Then
    MsgBox ("Duplicate unfullfilled requests where removed")
End If