Добрый день. Вроде бы тема про дублирование данных поднималась неоднократно и решений масса, это и формула в условное форматирование, и формула в дополнительном столбце, и формулы массива, и сводная таблица, и удалить дубликаты, и расширенный фильтр…. И т.д. Но конкретно к своей задаче я так решения и не нашел. Имеется большая таблица, порядка 30-ти полей и более 100 тыс записей, которые постоянно добавляются. При вводе пользователями новой записи (или редактировании старой) появляется возможность ошибочно ввести в определенное (ключевое) поле уже существующую запись. И данная погрешность может накапливаться. Собственно вопрос: Как посредством макроса с помощью автофильтра отфильтровать только те записи, которые имеют дубли, что бы дать пользователю выбрать какая из записей актуальна, а какую можно удалить прямо из тела рабочей таблицы. Почему именно макросом и посредством автофильтра? Условное форматирование и дополнительные столбцы не хочу использовать, так как, таблица большая и данное решение сильно замедлит общую работу таблицы. Эта проверка нужна будет только периодически при стечении определенных обстоятельств, и работа макроса не сильно будет напрягать. Так как возможно дублей может быть несколько, а в автофильтре допустимо только два критерия, то лучше критерии передавать через массив. Вот и сама суть вопроса как выбрать и засунуть в массив дублирующиеся записи? [vba]
Код
Sub AutoFil() Dim ValueArr() ValueArr = Array("1", "2", "3") Range("A1:B12").AutoFilter Range("A1:B12").AutoFilter Field:=1, Criteria1:=ValueArr, Operator:=xlFilterValues End Sub
[/vba]
Добрый день. Вроде бы тема про дублирование данных поднималась неоднократно и решений масса, это и формула в условное форматирование, и формула в дополнительном столбце, и формулы массива, и сводная таблица, и удалить дубликаты, и расширенный фильтр…. И т.д. Но конкретно к своей задаче я так решения и не нашел. Имеется большая таблица, порядка 30-ти полей и более 100 тыс записей, которые постоянно добавляются. При вводе пользователями новой записи (или редактировании старой) появляется возможность ошибочно ввести в определенное (ключевое) поле уже существующую запись. И данная погрешность может накапливаться. Собственно вопрос: Как посредством макроса с помощью автофильтра отфильтровать только те записи, которые имеют дубли, что бы дать пользователю выбрать какая из записей актуальна, а какую можно удалить прямо из тела рабочей таблицы. Почему именно макросом и посредством автофильтра? Условное форматирование и дополнительные столбцы не хочу использовать, так как, таблица большая и данное решение сильно замедлит общую работу таблицы. Эта проверка нужна будет только периодически при стечении определенных обстоятельств, и работа макроса не сильно будет напрягать. Так как возможно дублей может быть несколько, а в автофильтре допустимо только два критерия, то лучше критерии передавать через массив. Вот и сама суть вопроса как выбрать и засунуть в массив дублирующиеся записи? [vba]
Код
Sub AutoFil() Dim ValueArr() ValueArr = Array("1", "2", "3") Range("A1:B12").AutoFilter Range("A1:B12").AutoFilter Field:=1, Criteria1:=ValueArr, Operator:=xlFilterValues End Sub
уникальные вроде немного понятно как, а как дубли соображу.
Например, вот такой вариант [vba]
Код
Sub ttt() r0_ = 2 r1_ = Range("B" & Rows.Count).End(3).Row n_ = r1_ - r0_ + 1 ar = Range("B" & r0_).Resize(n_) Set Slov = CreateObject("Scripting.Dictionary") Set Slov1 = CreateObject("Scripting.Dictionary") On Error Resume Next For i = 1 To n_ Slov.Add ar(i, 1), "" If Err Then Err.Clear aaa = Slov1.Item(CStr(ar(i, 1))) End If Next On Error GoTo 0 ActiveSheet.Range("A1:B" & r1_).AutoFilter Field:=2, Criteria1:=Slov1.Keys(), Operator:=xlFilterValues End Sub
уникальные вроде немного понятно как, а как дубли соображу.
Например, вот такой вариант [vba]
Код
Sub ttt() r0_ = 2 r1_ = Range("B" & Rows.Count).End(3).Row n_ = r1_ - r0_ + 1 ar = Range("B" & r0_).Resize(n_) Set Slov = CreateObject("Scripting.Dictionary") Set Slov1 = CreateObject("Scripting.Dictionary") On Error Resume Next For i = 1 To n_ Slov.Add ar(i, 1), "" If Err Then Err.Clear aaa = Slov1.Item(CStr(ar(i, 1))) End If Next On Error GoTo 0 ActiveSheet.Range("A1:B" & r1_).AutoFilter Field:=2, Criteria1:=Slov1.Keys(), Operator:=xlFilterValues End Sub
_Boroda_, Спасибо! Если я правильно понял, то при добавлении в первый словарь если попадается дубль, то возникает ошибка и тогда добавляется во второй словарь?
_Boroda_, Спасибо! Если я правильно понял, то при добавлении в первый словарь если попадается дубль, то возникает ошибка и тогда добавляется во второй словарь?and_evg
при добавлении в первый словарь если попадается дубль, то возникает ошибка и тогда добавляется во второй словарь
Совершенно верно. Обратите внимание на методы добавления - первый генерит ошибку при дубляже, а второй добавляет только ключ и при дубле тупо его игнорит
при добавлении в первый словарь если попадается дубль, то возникает ошибка и тогда добавляется во второй словарь
Совершенно верно. Обратите внимание на методы добавления - первый генерит ошибку при дубляже, а второй добавляет только ключ и при дубле тупо его игнорит
Не совсем. При считывании из ячеек в массив последний всегда получается двумерным. Когда Вы делаете массив из диапазона А1:С9, то получаете массив (9,3), а когда из диапазона А1:А9, то получаете массив (9,1)
Не совсем. При считывании из ячеек в массив последний всегда получается двумерным. Когда Вы делаете массив из диапазона А1:С9, то получаете массив (9,3), а когда из диапазона А1:А9, то получаете массив (9,1)_Boroda_