Страницы: 1
RSS
Нужно удалить строки где есть уникальные значения столбца, т.е. остаться должны строки с дублями., Уже съел 2 клавиатуры
 
выборку нужно сделать по столбцу В и что бы остались строки с дублированными значениями в столбце В
Изменено: Thrashx666 - 13.04.2018 09:34:49
 
И Вам здравствуйте! Thrashx666, это Вы кому задания раздаёте?
 
Доброе время суток
Цитата
Уже съел 2 клавиатуры
А что СЧЁТЕСЛИ уже не работает?
 
Thrashx666, Есть мнение, что все участники уже сочувствуют и по поводу наличия такой потребности, и по поводу 2х клавиатур.
Пока не употребили третью ,уделите чуток времени правилам форума.
Изменено: БМВ - 13.04.2018 09:16:16
По вопросам из тем форума, личку не читаю.
 
Цитата
Thrashx666 написал:
уникальные значения столбца, т.е. остаться должны строки с дублями
как их разобрать кто из них уникальный а кто дубль например кто из них кто 2, 2, 2
по ссылке не ходил
Лень двигатель прогресса, доказано!!!
 
я имел в виду если фамилия и инициалы повторяются, то это дубль если нет то уникальный.
 
Thrashx666, мы примерно поняли что вы в виду имели, поймите теперь и то, что вам написали в сообщениях 2-5
По вопросам из тем форума, личку не читаю.
 
извините за ссылку, не знаю как вам файл показать слишком большой.
 
Thrashx666, а здесь Ваш рабочий файл не нужен, оставте несколько строк где есть повторения и потом покажите что вы хотите что б получилось из этих строк и все.
Не бойтесь совершенства. Вам его не достичь.
 
нужно сравнить фамилии в столбце В, если они повторяются то вся строка с 8 столбцами остается, а уникальные удаляются. Если есть макрос это было бы супер
 
Thrashx666, какой то странный подход у вас ну например встретилась у вас в тексте Хамидуллина Р.А. 3 раза т.е вы хотите чтоб 1 уникальная запись удалилась а 2 остались или все таки вы хотите оставить одну последнюю запись
Лень двигатель прогресса, доказано!!!
 
что бы Хамидуллина Р.А. осталась 3 раза, а остальные были удалены:
13.04.2014   00:00Хамидуллина Р.А.РозаАсраровнаХамидуллина06.03.1960 00:008-9122128845РФ,   Свердловская, Бисерть, Машиностроителей, 11
13.04.2014   00:00Хамидуллина Р.А.РозаАсраровнаХамидуллина06.03.1960 00:008-9122128845РФ,   Свердловская, Бисерть, Машиностроителей, 11
13.04.2014   00:00Хамидуллина Р.А.РозаАсраровнаХамидуллина06.03.1960 00:008-9122128845РФ,   Свердловская, Бисерть, Машиностроителей, 11
что бы осталось вот так
 
формулой результат на соседний лист, ждите рунописцев
Лень двигатель прогресса, доказано!!!
 
Код
Sub kk()
With Application: .ScreenUpdating = False: .Calculation = xlCalculationManual: .DisplayAlerts = False: End With
Dim rng As Range, dic
Set dic = CreateObject("Scripting.Dictionary")
For Each cl In Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)
    If dic.exists(cl.Value) Then
    dic.Item(cl.Value) = 2
    Else
    dic.Add cl.Value, 1
    End If
Next
For Each k In dic.keys
    If dic.Item(k) = 1 Then dic.Remove k
Next
If AutoFilterMode = False Then Range("A1:H" & Cells(Rows.Count, "A").End(xlUp).Row).AutoFilter
    Range("A1:H" & Cells(Rows.Count, "A").End(xlUp).Row).AutoFilter Field:=2, Criteria1:=Array(dic.keys), Operator:=xlFilterValues
    Set rng = ActiveSheet.UsedRange.SpecialCells(12)
    Worksheets.Add
    rng.Copy Range("A1")
With Application: .ScreenUpdating = True: .Calculation = xlCalculationAutomatic: .DisplayAlerts = True: End With
End Sub
Изменено: yozhik - 13.04.2018 10:44:47
 
Имхо тут проще как уже подсказали применять счётесли(), фильтр/сортировку и руки, чем макрос, который 100% ещё придётся подгонять под рабочий файл, и вероятно ещё корректировать под каждый файл.
Ну или нужно писать макрос, который работает с выделенным диапазоном, что в итоге будет не сильно отличаться от протягивания формулы.
 
Цитата
yozhik написал:
13 Апр 2018 10:41:56



Код ? 123456789101112131415161718192021Sub kk()With Application: .ScreenUpdating = False: .Calculation = xlCalculationManual: .DisplayAlerts = False: End WithDim rng As Range, dicSet dic = CreateObject("Scripting.Dictionary")For Each cl In Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)    If dic.exists(cl.Value) Then    dic.Item(cl.Value) = 2    Else    dic.Add cl.Value, 1    End IfNextFor Each k In dic.keys    If dic.Item(k) = 1 Then dic.Remove kNextIf AutoFilterMode = False Then Range("A1:H" & Cells(Rows.Count, "A").End(xlUp).Row).AutoFilter    Range("A1:H" & Cells(Rows.Count, "A").End(xlUp).Row).AutoFilter Field:=2, Criteria1:=Array(dic.keys), Operator:=xlFilterValues    Set rng = ActiveSheet.UsedRange.SpecialCells(12)    Worksheets.Add    rng.Copy Range("A1")With Application: .ScreenUpdating = True: .Calculation = xlCalculationAutomatic: .DisplayAlerts = True: End WithEnd Sub

Изменено: yozhik  - 13 Апр 2018 10:44:47
выкидывает ошибку и удаляет весь файл под 0
 
В коде удаление под ноль не предусмотрено. Код надо вставить в общий модуль, запустить со страницы, где отбираете дубли
Все цифры скопированные и вставленные до строки Sub kk удалить в модуле
Изменено: yozhik - 13.04.2018 10:58:17
 
кросс
По вопросам из тем форума, личку не читаю.
 
Цитата
БМВ написал:
кросс
ага
 
Thrashx666, Что ага? Правила по диагонали?
Цитата
4. Не рекомендуется
   4.1. Создавать одинаковые темы или сообщения в разных форумах (cross-posting). Публикуя один и тот же вопрос в разных форумах и на дружественных сайтах вы заставляете сразу нескольких людей параллельно думать над вашей задачей и обесцениваете усилия тех, кто даст ответ вторым-третьим и т.д.
По вопросам из тем форума, личку не читаю.
 
Thrashx666, мне надоело удалять Ваше бестолковое цитирование! Сообщение №16 чистите сами.
И правила читайте.
Страницы: 1
Наверх