Удалить дубли по определнному критерию, не полное совпадение

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по Excel » Удалить дубли по определнному критерию, не полное совпадение (Формулы/Formulas)

imagazina

Дата: Вторник, 03.05.2016, 19:27 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 8

Репутация: 0 ±

Замечаний: 0% ±

Excel 2007

Есть таблица Ексель, большая, более 100к строк и в каждой строке около 10 ячеек. Стоит задача избавиться от дублей в таблице
Дублем считается, если в ячейке B любой строки повторяется один и тот же емаил, при этом другие ячейки, которые присутствуют на таких строчках могут отличаться. Как из этих дублирующихся по выбрать любую из строк, а остальные удалить. Нужно оставить любую из этих строк, но только одну

В прикрепленном фаиле еще раз пояснил задачу.
Спасибо за помощь)

К сообщению приложен файл: 8022827.xlsx (11.3 Kb)

Сообщение отредактировал imagazina - Вторник, 03.05.2016, 19:28

Ответить

sv2014

Дата: Вторник, 03.05.2016, 20:25 | Сообщение № 2

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 226

Репутация: 61 ±

Замечаний: 0% ±

Excel 2013

imagazina, добрый вечер,попробуйте макрос,кнопка example,для повтора скопируйте данные с Лист2 на Лист1

[vba]

Код

Sub example()
    Dim z(), i&
    z = Range("A1:K" & Range("A" & Rows.Count).End(xlUp).Row).Value
    With CreateObject("scripting.dictionary"): .CompareMode = 1
        For i = UBound(z) To 1 Step -1
            .Item(z(i, 2)) = .Item(z(i, 2)) + 1
            If .Item(z(i, 2)) > 1 Then Rows(i & ":" & i).Delete
        Next
    End With
End Sub

[/vba]

К сообщению приложен файл: example_3_05_20.xls (48.5 Kb)

Сообщение отредактировал sv2014 - Вторник, 03.05.2016, 20:27

Ответить

МВТ

Дата: Вторник, 03.05.2016, 20:36 | Сообщение № 3

Группа: Проверенные

Ранг: Обитатель

Сообщений: 476

Репутация: 137 ±

Замечаний: 0% ±

Excel 2007

Я бы сделал так (оставляет первое вхождение по столбцу В)
[vba]

Код

Sub tt()
    Dim arr(), Dict As Object, i As Long, addr As String
    arr = Range("B1:B" & Cells(Rows.Count, "B").End(xlUp).Row)
    Set Dict = CreateObject("Scripting.dictionary")
    With Dict
        .comparemode = 1
        For i = 1 To UBound(arr)
            If .exists(arr(i, 1)) Then
                If addr = "" Then addr = "B" & i Else addr = addr & "," & "B" & i
            Else
                .Add Key:=arr(i, 1), Item:=0
            End If
        Next
        Range(addr).EntireRow.Delete
    End With
End Sub

[/vba]