Удалить дубликаты и предупредить пользователя с VBA - PullRequest
Новая
       13

Удалить дубликаты и предупредить пользователя с VBA

0 голосов
/ 23 мая 2019

Я важная информация, использующая мыльный вызов, моя проблема в том, что при определенных обстоятельствах я могу получить дубликаты данных.

Я могу легко удалить эти данные, используя
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")

Проблема, конечно, в том, что это либо отображает сообщение для каждого дублирующегося значения, удаленного в цикле, либо даже еслидубликатов нет (как сейчас).В идеале я хочу, чтобы удаление дубликатов выполнялось полностью, а затем предупреждала пользователя с помощью сообщения.

С уважением, Сэм

1 Ответ

0 голосов
/ 23 мая 2019 
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
...