Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Удалить дубли по определнному критерию, не полное совпадение - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Удалить дубли по определнному критерию, не полное совпадение (Формулы/Formulas)
Удалить дубли по определнному критерию, не полное совпадение
imagazina Дата: Вторник, 03.05.2016, 19:27 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

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

В прикрепленном фаиле еще раз пояснил задачу.
Спасибо за помощь)
К сообщению приложен файл: 8022827.xlsx(11Kb)


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

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

Автор - imagazina
Дата добавления - 03.05.2016 в 19:27
sv2014 Дата: Вторник, 03.05.2016, 20:25 | Сообщение № 2
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 156
Репутация: 37 ±
Замечаний: 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(48Kb)


Сообщение отредактировал sv2014 - Вторник, 03.05.2016, 20:27
 
Ответить
Сообщение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]

Автор - sv2014
Дата добавления - 03.05.2016 в 20:25
МВТ Дата: Вторник, 03.05.2016, 20:36 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 475
Репутация: 135 ±
Замечаний: 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]


Сообщение отредактировал МВТ - Вторник, 03.05.2016, 20:38
 
Ответить
СообщениеЯ бы сделал так (оставляет первое вхождение по столбцу В)
[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]

Автор - МВТ
Дата добавления - 03.05.2016 в 20:36
krosav4ig Дата: Вторник, 03.05.2016, 20:41 | Сообщение № 4
Группа: Друзья
Ранг: Старожил
Сообщений: 1336
Репутация: 533 ±
Замечаний: 0% ±

Excel 2007, 2013
можно удалить повторы расширенным фильтром (условие отбора в ячейке L2)
Данные>Сортировка и фильтр>Дополнительно
далее заполняем по скрину, жмем ОК
К сообщению приложен файл: 1392324.xlsx(13Kb) · 8332467.gif(29Kb)


(_)Õvõ(_)

Сообщение отредактировал krosav4ig - Вторник, 03.05.2016, 20:42
 
Ответить
Сообщениеможно удалить повторы расширенным фильтром (условие отбора в ячейке L2)
Данные>Сортировка и фильтр>Дополнительно
далее заполняем по скрину, жмем ОК

Автор - krosav4ig
Дата добавления - 03.05.2016 в 20:41
sv2014 Дата: Вторник, 03.05.2016, 20:50 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 156
Репутация: 37 ±
Замечаний: 0% ±

Excel 2013
imagazina, добавил к своему варианту кнопку повтор

[vba]
Код
Sub повтор()
Sheets("Лист2").UsedRange.Copy Sheets("Лист1").Range("A1")
End Sub
[/vba]
К сообщению приложен файл: 1233059.xls(51Kb)


Сообщение отредактировал sv2014 - Вторник, 03.05.2016, 21:32
 
Ответить
Сообщениеimagazina, добавил к своему варианту кнопку повтор

[vba]
Код
Sub повтор()
Sheets("Лист2").UsedRange.Copy Sheets("Лист1").Range("A1")
End Sub
[/vba]

Автор - sv2014
Дата добавления - 03.05.2016 в 20:50
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Удалить дубли по определнному критерию, не полное совпадение (Формулы/Formulas)
Страница 1 из 11
Поиск:

Яндекс цитирования
© 2010-2016 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!