Страницы: 1 2 След.
RSS
Массовое удаление строк по заданному массиву слов, VBA, макрос
 
Здравствуйте Гуру VBA!

Так уж случилось, что совсем недавно, открыл для себя этот увлекательный мир программирования. Начал самостоятельное знакомство с Liberty Basic. Все здорово, но есть задание, на выполнение которого отнимается много времени. Его выполняет программа "Macro Recorder" и это 30 минут "реального втыка". Вот бы кто подкинул макрос на VBA.
Скрытый текст

З.Ы.
Искал макрос по массовому удалению через массив и когда попал на этот сайт, то понял, что мне обязательно здесь помогут и поэтому я решил немедленно пройти регистрацию, чтобы создать эту актуальную тему, которая будет полезна не только мне, но и всем желающим находить ответы на вечные вопросы. Да, хочу сам научится писать скрипты, чтобы помогать себе и другим и такое будет. Спасибо planetaexcel за сервис. И всем тем, кто небезразличен к людям.
Изменено: Сергеевич - 12.07.2016 01:20:34 (ссылка не та, что нужно была)
 
Код
Sub УдалениеСтрокПоУсловию()
    Dim ra As Range, delra As Range, ТекстДляПоиска As String
    Application.ScreenUpdating = False    ' отключаем обновление экрана

    ТекстДляПоиска = "Наименование ценности"    ' удаляем строки с таким текстом

    ' перебираем все строки в используемом диапазоне листа
    For Each ra In ActiveSheet.UsedRange.Rows
        ' если в строке найден искомый текст
        If Not ra.Find(ТекстДляПоиска, , xlValues, xlPart) Is Nothing Then
            ' добавляем строку в диапазон для удаления
            If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
        End If
    Next
    ' если подходящие строки найдены - удаляем их
    If Not delra Is Nothing Then delra.EntireRow.Delete
Application.ScreenUpdating = True    ' включаем обновление экрана
End Sub
У меня в копил есть такой макросс. Подставляйте любое слово  в ковычки в теле макроса     (ТекстДляПоиска = "Наименование ценности"    )
 
Цитата
Сергеевич написал Посавлю пиво тому, кто "подгонит" правильный макросс!
А QwertyBoss мне коньяк обещал. Ставки падают.
 
Цитата
Kuzmich написал: А QwertyBoss мне коньяк обещал.
Щаззз ))
 
Цитата
Сергеевич написал: чтобы создать эту актуальную тему, которая будет полезна не только мне, но и всем желающим находить ответы на вечные вопросы
чтобы находить, надо хотя бы начать искать. Тем по удалению строк на форуме и в сети валом. Достаточно открыть Яндекс, Гугл и Поиск форума.
Я уже давно выложил открытый код: Как удалить строки по условию?
Цитата
Сергеевич написал: Да, хочу сам научится писать скрипты
Хм...если хотите - где хотя бы одна строка кода в Вашем файле и вопросы о том, почему код работает медленно вместо просьбы выложить код с нуля?
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Сергеевич,  проще и быстрее через фильтр. Создаете именованный диапазон Брэнды, записываете туда названия и запускаете такой макрос
Код
Sub tt()
    With Sheets("PITSTOP.COM.UA").UsedRange
        .AutoFilter Field:=2
        .AutoFilter Field:=2, Criteria1:=Application.WorksheetFunction.Transpose(Range("Брэнды").Value), Operator:=xlFilterValues
        .SpecialCells(xlCellTypeVisible).EntireRow.Delete
        .AutoFilter Field:=2
    End With
End Sub
P.S. после слов метров даже неловко стало :oops:
Изменено: МВТ - 30.01.2016 14:31:29
 
QwertyBoss, по одному слову удалять - это долго. У меня есть список слов, который нужно запихнуть в "ТекстДляПоиска" например:
Код
ТекстДляПоиска = "Атитас","Мума","Рипак", "Снифегс" итд ` только как?
 
Цитата
Сергеевич написал:
У меня есть список слов
По ссылке так и не сходили...
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
The_Prist, какие ссылки? Даже в теме не прочитал  8-0
 
The_Prist, Вашу статью гугл любит и держит ее в топе и я там был, до прихода на этот сайт.  
Ваши макросы мне не подошли. Нужно, чтобы макрос искал "сразу" несколько слов (200 слов) и удалял строки в которых они есть :)
 
Цитата
МВТ написал:
 проще и быстрее через фильтр. Создаете именованный диапазон Брэнды, записываете туда названия и запускаете такой макрос
Слишком профессионально ответили. Сейчас перевариваю Ваш ответ. Когда переварится - сообщу о достижениях
 
Цитата
Сергеевич написал: Нужно, чтобы макрос искал "сразу" несколько слов (200 слов) и удалял строки в которых они есть
Не удалять, а выбрать без нежеланных 200 - вариант?! Запросом, фильтрами, макросом - с чего начнете выполнять ВАШЕ задание?!. ;)
Изменено: Z - 30.01.2016 15:22:07
"Ctrl+S" - достойное завершение ваших гениальных мыслей!.. ;)
 
Цитата
Kuzmich написал: А QwertyBoss мне коньяк обещал. Ставки падают.
Интерестно, за что?
 
Цитата
Kuzmich написал: А QwertyBoss мне коньяк обещал. Ставки падают.
А где адрес, куда посылать? =)
 
Цитата
Сергеевич написал:
Нужно, чтобы макрос искал "сразу" несколько слов (200 слов) и удалял строки в которых они есть
Да ВЫ что? Правда? А до конца статью дочитать не пробовали? И найти там последний код, которые именно это и делает? Вот такими буквами написано: УДАЛЕНИЕ СТРОК НА ОСНОВАНИИ СПИСКА ЗНАЧЕНИЙ(МНОЖЕСТВЕННЫЕ КРИТЕРИИ)

Теперь понятно, почему Вы ничего не нашли. Как я уже писал - находит лишь тот, кто ищет :)
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
The_Prist, спасибо, весьма познавательная статья. Я так понимаю, способ с фильтром медленнее?
 
Если фильтровать список поочередно - то вполне может проиграть. Код из статьи можно еще чуть ускорить(тогда точно быстрее будет), если на каждом листе значения тоже в массиве перебирать и сравнивать, а к ячейкам обращаться только если критерий подходит. Плюс есть нюансы у фильтра при использовании из VBA: если надо по датам удалять - не всегда сработает как ожидается. Такая же проблема может быть и при примененном к ячейкам форматам. поэтому чтобы наверняка, лучше я думаю уж расширенный фильтр применять со списком параметров в отдельном листе.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
The_Prist, Дочитано до дна, просто не представляю как он работает и поэтому он мне не пригодился.
Нужно видео, как минимум, если Вы хотите, чтобы Ваш макрос был полезен не только бывалым.
 
The_Prist, спасибо, идея с расширенным фильтром интересная.
Сергеевич,а зачем Вам видео, чтобы скопировать, а потом запустить ГОТОВЫЙ макрос?
 
Цитата
Сергеевич написал: Дочитано до дна
Нужно видео
Теперь понятно. Вы из тех, что читает до дна, но через строку, надеясь сразу найти то, что нужно и чтобы прямо в рот положили разжевав. Об этом говорит даже эта Ваша фраза:
Цитата
Сергеевич написал: Нужно, чтобы макрос искал "сразу" несколько слов (200 слов) и удалял строки в которых они есть
Если бы до дна читали - то этой фразы бы не было, а сразу бы было написано, что я видел, но как применить не понял.
Могу, конечно, ошибаться, но если для Вас создать модуль в книге и поместить в него код так сложно настолько, что даже нужно видео для этого делать - значит Вы рано принялись за решение таких задач. В статье есть все подходящие ссылки и описания для того, чтобы можно было воспользоваться кодами. Для тех, кто не до дна читает, а внимательно и вдумчиво...
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Цитата
The_Prist написал: Теперь понятно. Вы из тех, что читает до дна, но через строку...
Хорошо, что Вы поняли это. Но в самом начале я про это дал намёк. (что я далёк от VB)  вот Ваш код:
Код
Sub Del_Array_SubStr()
    Dim sSubStr As String    'искомое слово или фраза
    Dim lCol As Long    'номер столбца с просматриваемыми значениями
    Dim lLastRow As Long, li As Long
    Dim avArr, lr As Long

    lCol = Val(InputBox("Укажите номер столбца, в котором искать указанное значение", "Запрос параметра", 1))
    If lCol = 0 Then Exit Sub
    Application.ScreenUpdating = 0
    lLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
    'Получаем с Лист2 значения, которые надо удалить в активном листе
    With Sheets("Лист2") 'Имя листа с диапазоном значений на удаление
        avArr = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
    End With
    'удаляем
    Dim rr As Range
    For lr = 1 To UBound(avArr, 1)
        sSubStr = avArr(lr, 1)
        Set rr = Nothing
        For li = 1 To lLastRow
            If Cstr(Cells(li, lCol)) = sSubStr Then
                If rr Is Nothing Then
                    Set rr = Cells(li, 1)
                Else
                    Set rr = Union(rr, Cells(li, 1))
                End If
            End If
        Next li
        If Not rr Is Nothing Then rr.EntireRow.Delete
    Next lr
    Application.ScreenUpdating = 1
End Sub

Куда можно вставить несколько значений: "Тыква", "Груша", "Яблоки", "Илюша"?
Изменено: Сергеевич - 30.01.2016 16:15:51 (пук)
 
Цитата
Ниже приведен код, при помощи которого можно удалить строки, указав в качестве критерия диапазон значений. Т.е. указав на "Лист2" в столбце А(начиная с первой строки) несколько значений - они все будут удалены. Если лист называется иначе(скажем "Соответствия") в коде необходимо будет "Лист2" заменить на "Соответствия"
Далее даже в коде есть комментарии:
Код
'Получаем с Лист2 значения, которые надо удалить в активном листе
    With Sheets("Лист2") 'Имя листа с диапазоном значений на удаление
        avArr = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
    End With

Т.е. в книге два листа. Первый - с таблицей для чистки. Второй - со значениями, которые надо найти и удалить. Он в коде называется "Лист2". Если у Вас он называется иначе - значит надо в коде заменить "Лист2" на свое имя листа. Сделать это надо лишь в одном месте - в приведенном мной выше куске кода.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
The_Prist,  :) УраЙ Работает. Скиньте свои банковские реквизиты в лс
 
Цитата
Сергеевич написал: Скиньте свои банковские реквизиты
Полагаю, это лишнее.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
The_Prist, я какое-то время пользовался Вашим кодом для удаления строк на основании списка значений, очень здорово все работало! Но, насколько я понял, данный код находит и удаляет строки в случае если в ячейке содержится только одно значение точно совпадающее со значением из Листа2.
Например, если в моем списке, который нужно почистить, есть ячейка с содержимым "Василий" и на втором листе есть "Василий", то все прекрасно работает, а если в моем списке для чистки есть ячейка "Василий Петрович", то она удалена не будет. Подскажите пожалуйста, какие изменения нужно внести в код, чтобы он находил не только точные соответствия, но и как часть содержимого ячейки.
Т.е. чтобы добавив на второй лист значение "Петров" у меня с первого листа удалилась строка содержащая "Василий Петрович"
Заранее огромное спасибо!

Я пытался сделать это просто фильтром, он хорошо для этого подходит, вбивал часть слова, он находил ячейки и я их удалял, но у меня список из нескольких тысяч слов и вбивать их по одному очень уж тягостно :(
 
Зайдите на сайт, скачайте файл или скопируйте код.
Измените строку:
Код
If CStr(arr(li, 1)) = sSubStr Then
на такую:
Код
If InStr(1, arr(li, 1), sSubStr,1) > 0 Then
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
The_Prist, Спасибо огромное, все работает!
 
УДАЛЕНИЕ СТРОК НА ОСНОВАНИИ СПИСКА ЗНАЧЕНИЙ(МНОЖЕСТВЕННЫЕ КРИТЕРИИ)
 День добрый всем. Так и не понял как изменить что бы он удалял только одно найденную ячейку(если их найдено >1), хотелось бы все найденные одинаковые вывести строки и выбрать какую именно удалить. За ранние, Спасибо!
....
есть массив табличка 2к фио(англ(транслит)) и номер(4цывры)(редко совпадают) и каждый день приносят 50-100 номеров фио(рус(кириллица)) нужно удалить из таблички
При поиске в ручную находит два значение номера, сравниваю фамилии в голове включаю транслит и сравниваю что в таблице и удаляю строку
Изменено: Kills911 - 12.07.2016 01:21:44
 
Тема о массовом удалении строк, а Вам нужно удалить одну ячейку (если удалить ячейку - дырка в листе будет)
Создайте отдельную тему.
 
Может что то напутал допустим из лист2 первое значение  найдено 2 строки с одинаковыми содержимым он удалит обе. Над предоставить выбор в ручную. Все остальное по цыклу.
Дырки в листе не оставляет..

vikttur
извиняюсь не то написал, не ячейку а строку.  
Изменено: Kills911 - 12.07.2016 08:34:51
Страницы: 1 2 След.
Читают тему
Наверх