Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
VBA. Удалить все одинаковые строки в выделенном столбце.
 
#1
16.07.2015 07:40:26
Всем привет!

Нужно удалить все повторяющиеся(и пустые) строки(без дубликатов) на основании первого столбца. Удаленные строки остаются пустыми.
ДО:
Скрытый текст

ПОСЛЕ:
Скрытый текст

Сначала использовал встроенную функцию поиска одинаковых значений в выделенном тексте, немного доработал, но результата всё равно нет.
Код
Sub Макрос1()
'
' Макрос1 Макрос
' Сначала макрос ищет одинаковые строки в первом столбце и когда находит - помечает их цветом(как и значения внутри ячейки).
' Затем макрос проходит от последней ячейки снизу до самой первой в поисках ячеек в первом столбце, которые закрашены определенным цветом. 
' Их-то он и должен удалять. Но не удаляет.

    Columns("A:A").Select
    Selection.FormatConditions.AddUniqueValues
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).DupeUnique = xlDuplicate
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13551615
        .TintAndShade = 0
    End With
    
    For i = (ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count) To 1 Step -1
        If    (Selection.Cells(i, 1).Interior.Color = 13551615) Then
              Selection.Rows(i).Delete Shift:=xlUp
        End If
    Next i
    Selection.FormatConditions(1).StopIfTrue = False
End Sub
 
 
 
#2
16.07.2015 07:51:29
Можно так:
Код
Sub qq()
    Dim x As Range, i As Long
    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        If Application.CountIf([A:A], Cells(i, 1)) > 1 Or Cells(i, 1) = "" Then _
        If x Is Nothing Then Set x = Rows(i) Else Set x = Union(x, Rows(i))
    Next
    If Not x Is Nothing Then x.Delete
End Sub
Изменено: SAS888 - 16.07.2015 07:55:10
Чем шире угол зрения, тем он тупее.
 
 
 
#3
16.07.2015 08:11:02
Код
Sub qq()
' Задаём переменную
    Dim x As Range, i As Long


' Запускаем цикл, который идёт с первой строки по последнюю
    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
'  Здесь только понял, что если просматриваемые строки в первом столбце >1(это как?) или пусты, тогда _(что это значит?)
        If Application.CountIf([A:A], Cells(i, 1)) > 1 Or Cells(i, 1) = "" Then _
' Второй цикл выполняется, если условие предыдущего верно. Если значение переменной "x" пусто, значит присваиваем ей номер строки, иначе что?
        If x Is Nothing Then Set x = Rows(i) Else Set x = Union(x, Rows(i))
    Next
' Если значение переменной "x" не пусто, тогда значение "x" удаляется.
    If Not x Is Nothing Then x.Delete
End Sub
Если Вас не затруднит, можете описать? Пытаюсь сам разобраться, но пока плохо получается.
 
 
 
#4
16.07.2015 08:22:25
Цикл здесь один. Проходим по всем ячейкам столбца "A", проверяем требуемые условия, формируем диапазон строк для последующего удаления.
И если этот диапазон есть, то удаляем.
Тот же код с комментариями:
Код
Sub qq()
'Определяем иеременные
    Dim x As Range, i As Long
'Организуем цикл от 1-ой до последней заполненной строки в 1-ом столбце
    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
'Если количество ячеек в столбце "A", содержащих текущее значение, больше 1, либо ячейка пуста, то...
        If Application.CountIf([A:A], Cells(i, 1)) > 1 Or Cells(i, 1) = "" Then _
'Если в "x" пусто, то присваиваем "x" текущую строку. Иначе - добавляем ее к существующему "x"
        If x Is Nothing Then Set x = Rows(i) Else Set x = Union(x, Rows(i))
    Next
'Если в "x" не пусто, то удаляем диапазон "x"
    If Not x Is Nothing Then x.Delete
End Sub
Изменено: SAS888 - 16.07.2015 08:24:47
Чем шире угол зрения, тем он тупее.
 
 
 
#5
16.07.2015 11:14:54
я бы заметил , что countif - это тоже цикл, с перебором всех заполненных ячеек между прочим, на каждом шаге цикла, правда с этим трудно бороться.. словари побыстрее проверку осуществляют - их можно задействовать
и проверка на каждом шаге if not is nothing тоже не слишком экономно - проверять можно до первого присваивания, а затем уже не имеет смысла. Да в коде будет два цикла, но последовательных, а не вложенных, и с тем же суммарным количеством шагов..
Изменено: Слэн - 16.07.2015 11:15:14
Живи и дай жить..
 
 
 
#6
16.07.2015 11:22:49
да, и оператор or в if then заставляет делать обязательно две проверки, тогда как исполнитья может только одно из условий - эффективнее делать:
Код
if Cells(i, 1) <> "" Then
   if Application.CountIf([A:A], Cells(i, 1)) > 1 then
      ...
   endif
endif
Живи и дай жить..
 
 
 
#7
16.07.2015 11:49:27
В #1 а почему удалены все строки со значением 1? разве не должно остаться хотя бы одной?
Неизлечимых болезней нет, есть неизлечимые люди.
 
 
 
#8
16.07.2015 12:01:29
Нет:
Цитата
rango13 написал:
Нужно удалить все повторяющиеся(и пустые) строки(без дубликатов)
 
 
 
#9
31.08.2020 20:25:55
Спасибо знатокам за данный код. А возможно ли в данном случае сделать так, чтобы оставалась хотя бы одна строка из найденных дубликатов?

P.S. макрорекодер в данном случае не помогает, т.к. стандартная remove duplicates сдвигает ячейки вверх, заполняя пустые, и ячейки в строке теряют взаимосвязанность по данным. А настройки "оставить ячейки найденных дубликатов пустыми" не наблюдается=\.
Изменено: Кирилл Блинов - 31.08.2020 20:35:02 (дополнение)
 
 
 
#10
31.08.2020 23:40:17
Создайте отдельную тему
 
 
 
Страницы: 1
Читают тему
Наверх