Проверка по принципы "Одна фамилия - один номер"

[artelow]

Здравствуйте. Есть очень большой список сотрудников с фамилиями и номерами телефонов.
Надо проверить по принципы "Одна фамилия - один номер".
В связи с большим объемом таблицы проверять вручную (фильтры, сортировки) очень много времени занимает.
Прошу помощи в решении данного вопроса. Буду благодарен любому совету.

p.s. Во вложенном списке ошибка показана красным шрифтом...

[doober]

Можно так проверить,первый телефон считается правильным

Sub НомерСотрудник()
    Dim Dx, C_is As Object, Key As String, Телефон As String
    With ActiveSheet
        Dx = .Range("B1", .Cells(.Rows.Count, 3).End(xlUp))
        Set C_is = CreateObject("scripting.dictionary")
        For n = 2 To UBound(Dx)
            Key = Dx(n, 1)
            Телефон = Dx(n, 2)
            If C_is.Exists(Key) Then
                If C_is.Item(Key) <> Телефон Then
                    .Cells(n, 3).Interior.Color = 255
                End If
            Else
                C_is.Item(Key) = Телефон
            End If
        Next
    End With
End Sub

[gling]

Можно встроенной функцией "Удалить дубликаты". На другом форуме есть подобная тема

[Казанский]

Если список отсортирован по фамилии, как в примере, то достаточно условного форматирования с простой формулой

=И($B2=$B1;$C2<>$C1)

Формула вводится при активной яч. А2.