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

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

1 个答案: