Удаление дубликатов макросом без помощи фильтра - Мир MS Excel

Регистрация

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

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

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

Удаление дубликатов макросом без помощи фильтра (Макросы/Sub)

Удаление дубликатов макросом без помощи фильтра

Дата: Среда, 02.12.2015, 19:01 | Сообщение № 1

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

Ранг: Участник

Сообщений: 87

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

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

Excel 2010

Добрый день господа! Есть задачка. Есть Маша, Коля и т.д. Как можно VBA (без фильтра и встройки "удаление дубликатов") найти всех Маш и удалить их кроме оригинала, т.е. самой первой по списку, не затрагивая разных Коль, Толь и т.д.
P/S. Найти Машу и удалить не проблема, а вот чтоб удалить всех Маш (кроме оригинала), чёт на форумах такого не встречал.... ссылка http://www.planetaexcel.ru/forum....-filtra

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

Ответить

Дата: Среда, 02.12.2015, 19:20 | Сообщение № 2

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

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

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

2010

Легким движением хвоста это превращается в это

[vba]

Код

Sub Мяу()
    Dim arr1
    arr1 = Range("A1").CurrentRegion.Value
    Dim lr&, col&, i&, j&
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    With CreateObject("Scripting.Dictionary")
        For i = 2 To lr
            .Item(arr1(i, 1)) = .Item(arr1(i, 1)) + 1
        Next
        Application.ScreenUpdating = False
        For i = lr To 2 Step -1
            If arr1(i, 1) = "Маша" Then
                If .Item(arr1(i, 1)) > 1 Then
                    Rows(i).Delete
                    .Item(arr1(i, 1)) = .Item(arr1(i, 1)) - 1
                End If
            End If
        Next
    End With
End Sub

[/vba]

Быть или не быть, вот в чем загвоздка!

Ответить

Дата: Среда, 02.12.2015, 19:20 | Сообщение № 3

Группа: Модераторы

Ранг: Старожил

Сообщений: 2290

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

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

2019

Словарь в помощь:
[vba]

Код

Sub d()
Dim dic As Object, c As Range
Set dic = CreateObject("scripting.dictionary")
For Each c In Selection
If dic.exists(c.Value) Then c.ClearContents Else dic.Add c.Value, c.Value
Next
End Sub

[/vba]
Нужно выделить обрабатываемый диапазон и нажать кнопку.
RAN опередил на несколько секунд

К сообщению приложен файл: 7210393.xlsm (43.3 Kb)

Иногда все проще чем кажется с первого взгляда.

Сообщение отредактировал SLAVICK - Среда, 02.12.2015, 19:24

Ответить

Дата: Среда, 02.12.2015, 19:36 | Сообщение № 4

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

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

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

2010

Цитата SLAVICK, 02.12.2015 в 19:20, в сообщении № 3

If dic.exists(c.Value) Then c.ClearContents Else dic.Add c.Value, c.Value

Тут не только Машам, но и SLAVICK'ам мало не покажется.

Быть или не быть, вот в чем загвоздка!

Ответить

Дата: Среда, 02.12.2015, 20:42 | Сообщение № 5

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

Ранг: Участник

Сообщений: 87

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

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

Excel 2010

Спс. за "мяу". Класс, работает! Ща буду разбирать по полочкам =). SLAVICKу тоже спасибо, у него почти такой же код как у Юрий М. Не знаю что у Вас за гонки, но пулучилось у всех. Только у "RAN в каске" ну... более заточен под необходимые условия. Спс. всем!!!!

Ответить

Дата: Среда, 02.12.2015, 21:41 | Сообщение № 6

Группа: Модераторы

Ранг: Старожил

Сообщений: 2290

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

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

2019

Цитата RAN, 02.12.2015 в 19:36, в сообщении № 4

Тут не только Машам, но и SLAVICK'ам мало не покажется.

Вот это я проглядел

т.е. нужно удалить только дубликаты "Маш"?
ну тогда и словарь не нужен - вот:
[vba]

Код

Sub d()
Dim c As Range, cF As Range, b As Boolean
For Each c In Range("A1").CurrentRegion
    If c.Value = "Маша" Then
        If Not b Then b = True Else If cF Is Nothing Then Set cF = c Else Set cF = Union(c, cF)
    End If
Next
cF.EntireRow.Delete
End Sub

[/vba]

К сообщению приложен файл: 6240026.xlsm (44.2 Kb)

Иногда все проще чем кажется с первого взгляда.

Сообщение отредактировал SLAVICK - Среда, 02.12.2015, 21:42

Ответить

Дата: Среда, 02.12.2015, 22:57 | Сообщение № 7

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

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

Сообщений: 226

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

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

Excel 2013

QwertyBoss, добрый вечер,Ваша тема продублирована одновременно на другом форуме
еще вариант,кнопки: test и восстановить на листе Лист1,данные изменяются на листе Лист2 для удобства тестирования.

[vba]

Код

Sub test()
   Dim z(), i&, t
    z = Sheets("Лист2").Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).Value
    With CreateObject("scripting.dictionary"): .comparemode = 1
    For i = 1 To UBound(z)
         .Item(z(i, 1)) = 0
   Next
   For i = UBound(z) To 2 Step -1
    If z(i, 1) = "Маша" Then Sheets("Лист2").Rows(i + 1 & ":" & i + 1).Delete
   Next
   End With
End Sub

[/vba]

К сообщению приложен файл: -49-3_11_2015_2.xls (44.0 Kb)

Сообщение отредактировал sv2014 - Среда, 02.12.2015, 23:02

Ответить

Дата: Среда, 02.12.2015, 23:11 | Сообщение № 8

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

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

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

2010

sv2014, меня еще на Планете подмывало задать вопрос, а зачем вы словарь заполняете?
Да, и если в Маша будет не в А2, а в А3, то Маш не останется.

Быть или не быть, вот в чем загвоздка!

Ответить

Дата: Среда, 02.12.2015, 23:22 | Сообщение № 9

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

Ранг: Участник

Сообщений: 87

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

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

Excel 2010

sv2014 спс. что откликнулись и не пожалели времени. Вариант более чем удачен. Возьму на вооружение =). Есть ряд задач к которым он идеально подходит. Ищщё раз спасибо...

Ответить

Дата: Среда, 02.12.2015, 23:24 | Сообщение № 10

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

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

Сообщений: 226

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

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

Excel 2013

Уважаемый RAN, добрый вечер,я ориентируюсь на файл-пример создателя темы,поэтому предложил такой код еще
на Планете,(здесь просто скопировал свой макрос,с небольшим изменением.С вашим кодом,обязательно ознакомлюсь.
Успехов Вам.

Ответить

Дата: Среда, 02.12.2015, 23:25 | Сообщение № 11

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

Ранг: Участник

Сообщений: 87

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

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

Excel 2010

SLAVICK спс. Стока решений... не ожидал. Впредь буду поаккуратней и не вылаживать темы на параллельных форумах =). Боюсь заглядывать на планету...

Сообщение отредактировал QwertyBoss - Четверг, 03.12.2015, 08:34

Ответить

Дата: Среда, 02.12.2015, 23:32 | Сообщение № 12

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

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

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

2010

Про файл-пример понятно.
Вы в коде заполняете словарь, который никак не используете. Зачем?

Цитата QwertyBoss, 02.12.2015 в 19:01, в сообщении № 1

найти всех Маш и удалить их кроме оригинала, т.е. самой первой по списку

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

Быть или не быть, вот в чем загвоздка!

Ответить

Дата: Четверг, 03.12.2015, 00:13 | Сообщение № 13

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

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

Сообщений: 226

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

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

Excel 2013

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

Ответить

Дата: Четверг, 03.12.2015, 10:27 | Сообщение № 14

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

Ранг: Участник

Сообщений: 87

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

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

Excel 2010

Вопрос к уважаемому RAN.
Есть
If arr1(i, 2) = "Перспективные работы(первоочередные работы)" Then - точное совпадение

Хочу сделать неточное совпадение
If arr1(i, 2).Value Like "Перспективные работы*" Then

А выходит ошибка, что неправильно делаю?

Сообщение отредактировал QwertyBoss - Четверг, 03.12.2015, 10:29

Ответить

Дата: Четверг, 03.12.2015, 10:41 | Сообщение № 15

Группа: Модераторы

Ранг: Старожил

Сообщений: 2290

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

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

2019

Цитата QwertyBoss, 03.12.2015 в 10:27, в сообщении № 14

arr1(i, 2)

Цитата QwertyBoss, 03.12.2015 в 10:27, в сообщении № 14

arr1(i, 2).Value

Найдите 10 отличий :)
Нужно так:
[vba]

Код

If arr1(i, 1) Like "Перспективные работы*" Then

[/vba]

Иногда все проще чем кажется с первого взгляда.

Сообщение отредактировал SLAVICK - Четверг, 03.12.2015, 10:44

Ответить

Дата: Четверг, 03.12.2015, 10:46 | Сообщение № 16

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

Ранг: Участник

Сообщений: 87

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

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

Excel 2010

Не выходит... =( прилагаю файл

К сообщению приложен файл: 8559926.xlsm (30.9 Kb)

Ответить

Дата: Четверг, 03.12.2015, 11:03 | Сообщение № 17

Группа: Модераторы

Ранг: Старожил

Сообщений: 2290

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

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

2019

Вы там поменяли цифры.
Попробуйте мой код - там практически ничего менять не нужно.:
[vba]

Код

Sub d()
Dim c As Range, cF As Range, b As Boolean
For Each c In Range("A1").CurrentRegion
    If c.Value Like "Перспективные работы*" Then
        If Not b Then b = True Else If cF Is Nothing Then Set cF = c Else Set cF = Union(c, cF)
    End If
Next
cF.EntireRow.Delete
End Sub

[/vba]
Сейчас посмотрю что там Вы поменяли в коде RAN - он немного сложнее чем мой

Посмотрел - поскольку используется словарь - он удаляет именно 100% совпадение, а поскольку данные отличаются - то дублей нет yes

yes

.
Можно конечно менять логику работы - если RAN захочет поменяет.
Мой макрос и так работает yes

yes

К сообщению приложен файл: 8559926-1-.xlsm (25.3 Kb)

Иногда все проще чем кажется с первого взгляда.

Сообщение отредактировал SLAVICK - Четверг, 03.12.2015, 11:17

Ответить

Дата: Четверг, 03.12.2015, 11:18 | Сообщение № 18

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

Ранг: Участник

Сообщений: 87

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

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

Excel 2010

SLAVICK спс. Работает . [Вы там поменяли цифры.] Цыфры менял по причине затачивания под проект. Но ПОЧЕМУ у Вас сработал, у RAN не получается. Оператор и там и там одинаковый =(

Ответить

Дата: Четверг, 03.12.2015, 11:21 | Сообщение № 19

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

Ранг: Участник

Сообщений: 87

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

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

Excel 2010

[Сейчас посмотрю что там Вы поменяли в коде RAN - он немного сложнее чем мой

Посмотрел - поскольку используется словарь - он удаляет именно 100% совпадение, а поскольку данные отличаются - то дублей нет yes .
Можно конечно менять логику работы - если RAN захочет поменяет.
Мой макрос и так работает yes]

Забираю!!!! Использую!!! Спс!!! hands

hands

Ответить

Дата: Четверг, 03.12.2015, 11:24 | Сообщение № 20

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

Ранг: Участник

Сообщений: 87

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

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

Excel 2010

Посоветуйте хорошую литературу по VBA.

Ответить

Удаление дубликатов макросом без помощи фильтра (Макросы/Sub)

Страница 1 из 2
1
2
»

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