mail mail
Нужен макрос для Excel?
Сделайте заказ прямо сейчас!
Ищете готовое решение?
Выбирайте и покупайте!
У вас есть интернет-магазин?
Настроим парсер под любой сайт!

Удаление (скрытие) строк по условию

макрос удалит на листе все строки, в которых содержится искомый текст:

(пример - во вложении ConditionalRowsDeleting.xls)

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
End Sub

Чтобы вместо удаления просто скрыть такие строки, замените строку

If Not delra Is Nothing Then delra.EntireRow.Delete

на
If Not delra Is Nothing Then delra.EntireRow.Hidden=TRUE


Расширенная версия этого макроса - с использованием UserForm для ввода искомого значения

(пример - в файле ConditionalRowsDeletingUsingUserform.xls)


Function ПоискСтрокПоУсловию(ByVal ТекстДляПоиска As String, Optional HideOnly As Boolean) As Long
    ' функция получает в качестве параметра ТекстДляПоиска (можно использовать символы * и ?)
    ' Если HideOnly = TRUE, то строки, содержащие в ячейках ТекстДляПоиска, скрываются,
    ' иначе (HideOnly = FALSE - по умолчанию) - удаляются
    ' Функция возвращает количество удалённых строк
    Dim ra As Range, delra As Range
    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
    On Error Resume Next: ПоискСтрокПоУсловию = delra.Areas.Count ' количество найденных строк
    
    If Not delra Is Nothing Then    ' если подходящие строки найдены - скрываем или удаляем их
        If HideOnly Then delra.EntireRow.Hidden = True Else delra.EntireRow.Delete
    End If
End Function


Ещё один вариант кода, позволяющего выполнять поиск (с последующим удалением или скрытием строк) сразу по нескольким условиям:

Sub УдалениеСтрокПоНесколькимУсловиям()
    Dim ra As Range, delra As Range
    Application.ScreenUpdating = False    ' отключаем обновление экрана

    ' ищем и удаляем строки, содержащие заданный текст
    ' (можно указать сколько угодно значений, и использовать подстановочные знаки)
    УдалятьСтрокиСТекстом = Array("Наименование *", "Количество", _
                                  "текст?", "цен*сти", "*78*")
 
    ' перебираем все строки в используемом диапазоне листа
    For Each ra In ActiveSheet.UsedRange.Rows
        ' перебираем все фразы в массиве
        For Each word In УдалятьСтрокиСТекстом
            ' если в очередной строке листа найден искомый текст
            If Not ra.Find(word, , xlValues, xlPart) Is Nothing Then
                ' добавляем строку в диапазон для удаления
                If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
            End If
        Next word
    Next
 
    ' если подходящие строки найдены, то: (оставьте одну из 2 следующих строк)
    If Not delra Is Nothing Then delra.EntireRow.Hidden = True    ' скрываем их
    If Not delra Is Nothing Then delra.EntireRow.Delete    ' удаляем их
End Sub

ВложениеРазмерЗагрузкиПоследняя загрузка
ConditionalRowsDeleting.xls24 КБ527212 часов 1 минута назад
ConditionalRowsDeletingUsingUserform.xls45.5 КБ1004 дня 20 часов назад

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

Подскажите, пожалуйста, какие изменения нужно внести в ваш макрос для скрытия просто пустых строк в диапазоне от 1 до 150 строки.

А как адаптировать Ваш макрос для ячейки с условием, например удалять строку если в ячейке значение больше, например, нуля?

уже все работает)

Не знаю, что вы там делаете, но строка "If ws.Index = 1 Then" явно не из моего макроса
(в моем макросе нет переменной ws)
Вот если вы показали бы полный код своего макроса - тогда можно было бы сказать, в чем именно ошибка.

У меня не удаляет ничего( Что я делаю не правильно?
удалять только на первом листе, который называется "накладная"
If ws.Index = 1 Then
Правильно?

Спасибо!!! Все работает как нужно - с Вашей помощью.

А вы попробуйте сначала удалить нули из ячеек

ws.Columns(4).replace "0","", xlWhole

А потом удаляйте строки с пустыми ячейками:

ws.Columns(4).SpecialCells(xlCellTypeBlanks).EntireRow.Delete


Или можете использовать функцию поиска всех заданных значений:

On Error Resume Next 
FindAll(ws.Columns(4), "0").EntireRow.Delete

Просмотрел много форумов по удалению строк через макрос. Нашел один который частично подходит мне, он удаляет строки если в 5 столбце пусто во всех листах кроме первого. Но не знаю как добавить, чтоб удалял еще и строки если в 4 столбце значение 0. Код быстрый (без цикла) а как дополнить - ума не приложу...
Sub DeleteEmptyRowsToAll()
Application.ScreenUpdating = False ' отключаем обновление экрана
On Error Resume Next
Dim ws As Worksheet 'декларирование переменой
For Each ws In Worksheets
If ws.Index > 1 Then ' кроме первого листа
ws.Columns(5).SpecialCells(xlCellTypeBlanks).EntireRow.Delete ' удаляем сразу все строки, в которых в 5-м столбце - пусто
End If
Next
End Sub

Заранее благодарю

Огромное спасибо за помощь!!! :)

Про чёрные ячейки в столбце...
Файл обновляется несколько раз в день - делать выборку вручную не вариант, нужен макрос.
А офис 2007 покупать шеф не хочет - 18 компов... Хватит вам и 2003, тем более официальный.
Про форум - пардон, не так назвал. Извините, если обидел.

Используйте фильтр по цвету (он доступен в Excel 2007 и выше): скройте все чёрные ячейки в столбце, после чего удалите видимые строки, и отключите фильтрацию.
Всё быстро и просто - и никаких макросов.

PS: Про какой форум речь? У меня на сайте форума нет, и не предвидится в ближайшем будущем...

Очень хороший форум! Часто им пользуюсь, а вот теперь забуксовал.
задача: имеется таблица, в которой, например, третий из столбец заполнен по принципу - или черная или белая ячейка. Нужно удалить строки с белыми ячейками в этом столбце. Заранее спасибо!

Вовсе необязательно вкладывать 3 условия в макрос.
Я бы на вашем месте в дополнительные столбец поместил формулу типа такой:
=ЕСЛИ(ИЛИ(Q1<5;НЕ(ЕОШ(НАЙТИ("текст";I1;1)));И(СЧЁТЕСЛИ(L:L;L1)=1;Q1>2));"";"не удаляем")

И потом бы макросом (или через автофильтр) удалил пустые строки по доп.столбцу

Добрый день, подскажите как написать макрос для скрытия и открытия (Или удаления) строк таблицы если в диапазоне ячеек [Пример:(d5:g100)] строка содержит в ячейках нули (или формулу, но отображает по формуле ноль)

Это как раз то что я так долго искал! Большое спасибо за информацию!

Помогите пожалуйста решить чуть более сложную задачу.
Есть несколько условий для удаления,
1) если значение ячейки (числовое) в столбце "Q" меньше "число" - удаляем строку
2) если значение ячейки (текстовое) в столбце "I" содержит "текст" - удаляем строку
И самое, наверное сложное:
3) если значение ячейки (текстовое) в столбце "L" встречается на листе только 1 раз и при этом значение ячейки (числовое) в столбце "Q" больше "число" - удаляем строку

И как все эти условия правильно в циклы вложить
PS В файле больше 30000 строк

Заранее спасибо! С уважением!

Большое спасибо за помощь! Работает!

Чтобы обработка ячеек начиналась с 15-строки, надо изменить анализируемый диапазон:

вместо

For Each ra In ActiveSheet.UsedRange.Rows

написать
For Each ra In intersect(ActiveSheet.UsedRange, range("15:" & rows.count)).Rows

Т.е. поиск будет производится на пересечении используемого диапазона листа, и диапазона строк с 15-й по последнюю строку листа
(таким образом мы отсекаем первые 14 строк)


Кир Булычев, причину такого поведения вашего макроса я не знаю.
Надо смотреть файл - возможно, проблема в нём.
И, кстати, для 10000 строк надо использовать другие, более правильные и быстрые, алгоритмы
(хотя бы потому, что Union работает медленно, и не может вмещать в себя более 1000 ячеек. Т.е. если у вас с нулями и единицами будет 1500 строк, - то удалится только около 1000 строк, остальные макрос пропустит)

PS: За помощью лучше обращайтесь на форумы по Excel
(я помогаю не бесплатно)

День добрый !

Вот пользовался макросом который Вы посоветовали (я заменил только локацию данных):

Sub УдалениеСтрокСТремяЗначениями()
' удаляются части строк, в кторых в столбце "O" находится 0, 1 или #N/A
On Error Resume Next
Dim cell As Range, delra As Range: Application.ScreenUpdating = False

For Each cell In Range("O:O").SpecialCells(xlCellTypeConstants)
If Val(cell) = 0 Or Val(cell) = 1 Then
If delra Is Nothing Then Set delra = cell Else Set delra = Union(delra, cell)
End If
Next cell
If Not delra Is Nothing Then Intersect(delra.EntireRow, Range("M:O")).Delete
Intersect(Range("O:O").SpecialCells(xlCellTypeConstants, xlErrors).EntireRow, Range("M:O")).Delete

- но вот недавно, увеличилось число обрабатываемых данных (со 180 до 380 строк, а будет и до 10 000) и если раньше макрос удалял данные в строках с "М" по "О" если в "О" содержатся "1", "0" или "N/A" и поднимал их вверх (т.е. удалял строки) - то теперь он также удаляет данные НО стирает не строки а 2 соседних столбца справа. При возврате к меньшему кол-ву обрабатываемых ячеек/данных - всё снова работает нормально.
Решил опять к Вам обратится за помощью т.к. составные этого макроса к сожалению находятся за граню моих познаний в VBA.

Буду очень благодарен если посоветуете что-нибудь.

Скажите, пжта, если надо начать рассматривать массив начиная допустим с 15-й строки. Какие изменения претерпит макрос?

Здравствуйте !
У меня вопрос по макросу "позволяющему выполнять поиск (с последующим удалением или скрытием строк) сразу по нескольким условиям:"

Мне нужно чтоб удалялись строки со значением НОЛЬ.
Ставлю "0" и удаляются все значения в значении которого есть НОЛЬ.

Как сделать что бы такого не происходила! Сохранив при этом удаление по нескольким условиям.

А можно как-то сделать так, чтобы этот макрос всегда был включен при заходе в файл Exela и работал динамически. К примеру, если поменяются данные в ячейках C2:CI2, то сразу скроются или отобразяться ячейки согласно макросу.

Вы правы!!! Спасибо большое, он работает хорошо! У меня неполучилось потому что я буквы ставил в ячейки, если подставить цифры то все будет работать правильно :)

Неужели? Плохо проверяли...
Этому макросу нет разницы, что в ячейках - формулы или значения.

Вот вам файл с формулами и этим макросом для проверки:
http://excelvba.ru/XL_Files/Sample__11-10-2011__14-46-12.zip

Sub СкрываемПустыеСтолбцы()
Dim cell As Range: Application.ScreenUpdating = False
For Each cell In [c2:ci2].Cells
' скрываем столбцы, если в ячейке ноль или пусто
cell.EntireColumn.Hidden = Val(cell) = 0
Next cell
End Sub

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

Моя задача решена. Спасибо огромное))) В целом - действовала по предложенному Вами плану))) Спасибо!)))))

В макросе в выражении ra.Find(word, , xlValues, xlPart) есть опция xlValues - она отвечает за поиск В ЗНАЧЕНИЯХ.
Есть и другие варианты этой опции:
xlFormulas - поиск в формулах
xlComments - поиск в комментариях к ячейке

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

Как бы для меня очень затруднительным получается п.3...((((

Т.е. создать бегунок по строкам (нахожу совпадение - копирую) нереально?(((((

Здравствуйте, Ольга.
Тут многое зависит от того, насколько "огромный" ваш файл (тысячи, десятки или сотни тысяч, миллион строк?)
При разных объёмах данных - разные алгоритмы.

Представленный мной код корректно работает для небольших таблиц (где число скрываемых\удаляемых строк не превышает тысячи)
Это ограничение легко обойти, но для увеличения производительности необходимо полностью изменить алгоритм макроса
(что моментально работает на тысячах строк, может нещадно тормозить на миллионе строк)

Самый простой способ, который приходит мне на ум - с использованием формулы в доп.столбце:
1) на отдельном листе делаем список из 50 позиций
2) в дополнительном (пустом) столбце с огромной таблицей пишем формулу, которая проверяет наличие одного из 50 слов в строке
3) применяем автофильтр в этому доп. столбцу, оставляя видимыми лишь те строки, для которых формула вернула результат "совпадение найдено"
4) выделяем и копируем видимые строки на другой лист

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

Буду признательна за любую помощь.
Спасибо)

Вам поможет такой макрос:
(не самый быстрый - но экономить миллисекунды не вижу смысла)

Sub СкрываемПустыеСтолбцы()
    Dim cell As Range: Application.ScreenUpdating = False
    For Each cell In [c2:ci2].Cells
        ' скрываем столбцы, если в ячейке ноль или пусто
        cell.EntireColumn.Hidden = Val(cell) = 0
    Next cell
End Sub

Автор помогите пожалуйста с решением данной задачи!!! Уже давно пытаюсь в интернете решить этот вопрос, никак не получается.
У меня есть таблица, которая состоит из строки (2) и столбцов (C:CI), в столбцах с помощью формул отображаются данные с числами и нулями или пустыми ячейками. Так как таблица с вводом новых значений в формулы постоянно меняет расположение пустых ячеек и нулей в данной строке (2) со столбцами (C:CI), то мне нужно автоматически скрывать все пустые ячейки или ячейки с нулями, а все ячейки с числами в строке (2), столбцы (C:CI) раскрывать. Помогите пожалуйста решить этот вопрос.

Огромное спасибо !

Теперь макрос короче и работает в два раза быстрее !

Очень признателен вам за помощь.

Попробуйте такой макрос:

Sub УдалениеСтрокСТремяЗначениями()
    ' удаляются части строк, в кторых в столбце J находится 0, 1 или #N/A
    On Error Resume Next
    Dim cell As Range, delra As Range: Application.ScreenUpdating = False
 
    For Each cell In Range("J:J").SpecialCells(xlCellTypeFormulas)
        If Val(cell) = 0 Or Val(cell) = 1 Then
            If delra Is Nothing Then Set delra = cell Else Set delra = Union(delra, cell)
        End If
    Next cell
    If Not delra Is Nothing Then Intersect(delra.EntireRow, Range("G:L")).Delete
 
    Intersect(Range("J:J").SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow, Range("G:L")).Delete
End Sub

Большое спасибо за ответ.

Я правда не указал, что в в столбце "J" ищу 3 значения для удаления - "#N/A", "0", "1". ( Думал своим умом дойду :) ). В результате в моём полном макросе 3 раза повторяется указанный мною макрос (чтобы удалить каждое значение).
В моей таблице с "G" по "L" указано название товара, а конкретно в "L" его наличие.

С помощью вашего совета я смогу убить лишь одного из своих трёх зайцев :(

Посоветуйте пожалуйста как модернизировать макрос для постоянных величин ( например "1")

Заранее благодарен.

В вашем случае можно использовать гораздо более простой и быстрый макрос:

Sub УдалениеПодстрокСОшибкамиВЗаданномСтолбце()
    Intersect(Range("J:J").SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow, Range("G:L")).Delete
End Sub

Этот код найдёт в столбце G активного листа ВСЕ ячейки с формулами, возвращающими ошибку (не только ошибку #N/A - но и любую другую),
после чего из найденных строк удалит ячейки столбцов G:L (со сдвигом вверх)

PS: Если у вас на листе не формулы, а значения с ошибками (результаты вычисления вставлены "как значения"),
замените в коде константу xlCellTypeFormulas на xlCellTypeConstants

День добрый !

Большое спасибо Вам за ваш макрос - которым сейчас регулярно пользуюсь.

Sub УдалениеСтрокПоУсловию()
Dim ra2 As Range, delra2 As Range, MyRange2 As Range
Set MyRange2 = Range("J:J")
Poisk2 = "#N/A"
For Each ra2 In MyRange2
If Not ra2.Find(Poisk2, , xlValues, xlWhole) Is Nothing Then
If delra2 Is Nothing Then Set delra2 = ra2 Else Set delra2 = Union(delra2, ra2)
End If
Next
If Not delra2 Is Nothing Then delra2.EntireRow.Delete

End Sub

Немного приспособил его для себя: Он у меня ищет в столбце "J" все "#N/A" и удаляет их.
Подскажите пожалуйста, ка сделать так, чтобы макрос не удалял ВСЮ строку а удалял её только в указанном диапазоне, например с "G" по "L" (по всей длине) ?

Дело в том, что у меня существует исходная таблица в столбцах от "А" до "Е", (из неё в последствии формируется таблица в диапазоне с "G" по "L" (они друг напротив друга). В результате работы макрос удаляет данные в обоих таблицах, а нужно чтобы только в одной.

Перерыл уже весь Интернет но ничего путного так и не смог найти, ни на русском ни на английском. Третий день бьюсь. :)

Заранее благодарен.

Спасибо!

Отобразить все строки вам поможет простейший макрос:

Sub ОтобразитьСтроки()
    Rows.Hidden = False
End Sub

Доброго времени суток!
Полнейший набор макросов для всех ситуаций, спасибо!
Скажите, если строки были не удалены а свёрнуты, можно их обратно развернуть?

"ИСТИНА" тоже не удаляется, этот макрос не хочет эти два слова воспринимать как текст при любых форматах ячейки.

Извините, не знаю прошло ли моё предыдущее сообщение я его продублирую.
Точно не в регистре дело. Галочка и была отжата. С другими словами и наборами больших букв этот макрос справлялся ("ПАРИ" удалил на раз).
После замен в модуле он вообще отказывается что либо делать:
Запись"Option Compare Text" - принимать нехочет, пишет Can`t execute code in break mode.

Sub УдалениеСтрокПоУсловию()
Option Compare Text
Dim ra As Range, delra As Range
Application.ScreenUpdating = False ' отключаем обновление экрана

ТекстДляПоиска = "ПАРИ" ' удаляем строки с таким текстом

' перебираем все строки в используемом диапазоне листа
For Each ra In ActiveSheet.UsedRange.Rows
' если в строке найден искомый текст
If Not ra.Find(word, , xlValues, xlPart, , , False) 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
End Sub

Без "Option Compare Text" с .Find(word, , xlValues, xlPart, , , False) - ругаться не ругается, но и делать тоже ничего не хочет.

По умолчанию поиск производится без учёта регистра символов
(параметр MatchCase метода Find имеет значение FALSE)

Но тут есть один нюанс - метод Find берет некоторые, явно не указанные, настройки из диалогового окна поиска:

(так что если вы раньше вручную выполняли поиск с учетом регистра символов - галочка могла остаться)

 

Что можно попробовать сделать в вашем случае:

1) в вышеуказанном диалоговом окне убрать галочку "учитывать регистр"

2) явно указать в коде, что поиск производится без учёта регистра:

заменить .Find(word, , xlValues, xlPart) на .Find(word, , xlValues, xlPart, , , False)

3) первой строкой в модуле поставить директиву Option Compare Text

 

Этот макрос, по удалению строки у меня не срабатывает с ячейками в которых текст "ЛОЖЬ", приходится этоти ячейки сначала перерабытывать в строчные буквы("ложь"), а потом пользоваться макросом. Подскажите, как можно исключать строки, в которых есть ячейки со значением "ЛОЖЬ" имеющим общий формат.

Огромное спасибо :-)

А вот и для вашего условия макрос:

Sub УдалениеСтрокСодержащихВсеЗаданныеЗначения()
    Dim ra As Range, delra As Range, WordsCount As Long
    ' ищем и удаляем строки, содержащие заданный текст (все значения)
    ' (можно указать сколько угодно значений, и использовать подстановочные знаки)

    Application.ScreenUpdating = False    ' отключаем обновление экрана на время удаления строк
    УдалятьСтрокиСТекстом = Array("Привет", "Здравствуйте")
 
    ' перебираем все строки в используемом диапазоне листа
    For Each ra In ActiveSheet.UsedRange.Rows
        WordsCount = -1
 
        ' перебираем все фразы в массиве
        For Each word In УдалятьСтрокиСТекстом
            ' если в очередной строке листа найден искомый текст
            ' то увеличиваем WordsCount на единицу
            WordsCount = WordsCount - (Not ra.Find(word, , xlValues, xlPart) Is Nothing)
        Next word
 
        ' строка  содержит ВСЕ заданные слова (количество найденный слов равно количеству заданных слов)
        If WordsCount = UBound(УдалятьСтрокиСТекстом) 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    ' удаляем эти строки
End Sub

Эх, чувствую, скоро мне придётся диссертацию писать по всевозможным методам поиска и удаления строк...

Привет.
Этот макрос удаляет строку при любом совпадении.
Как удалить строку если поиск ведется по значениям в разных ячейках
т.е если я ищу "Привет" и "Здравствуйте" оба значения найдены в одной строке но в разных ячейках - строку удалить !!
Заранее спасибо.

Уважаемый EducatedFool!

Спасибо Вам за ответ!

В случае циклической функции, я писал и "<>", и через IF NOT (в выложенном варианте ошибся и оставил только знак равенства) - но действительно пытался решить вопрос именно удаления строк НЕ содержащих заданных значений.

Но итог - удаляет или оставляет (в зависимости от условий) только первое условие. Почему то второе и тд условие(через OR или AND) в функции IF не учитывает. Да, или ,вообще, удаляет все строки(

Спасибо Вам за макрос, который Вы описали. Это, конечно, другой пилотаж если сравнивать с действием через цикл - долго и тд.

По вашей последней функции - она должна работать (хоть и очень-очень медленно)
Но... она удалит строки, где встречается любое из 2 заданных значений.
А именно это и делает мой макрос УдалениеСтрокПоНесколькимУсловиям, причем ГОРАЗДО БЫСТРЕЕ.

 

В предыдущем же комментарии вы просили совсем о другом:

Цель - удалить строки, в которых НЕ содержится текст. 

Для поиска строк, не содержащих заданные слова, мой макрос не подходит - поскольку алгоритм заметно меняется.

И удаление NOT тут не поможет.

Почему? Всё просто: сначала макрос занесёт в список удаляемых все строки, НЕ содержащие первого значения, потом в этот же список добавит все строки, НЕ содержащие второе значение.

И что же будет в результате, учитывая, что оба заданных вами значения не встречаются в одной строке?

Правильно - ВСЕ СТРОКИ ЛИСТА будут помечены как удаляемые.

Что делать? А переписывать макрос.

Поскольку одной командой 2 значения в строке не поищешь - придётся для каждой строки производить несколько операций поиска, и, если ВСЕ ЗАДАННЫЕ ЗНАЧЕНИЯ на найдены - только тогда помечать строку как удаляемую.

В итоге получится макрос для удаления строк, не содержащих заданные текстовые строки:

Sub УдалениеСтрокНеСодержащихЗаданныйТекст()
    Dim ra As Range, delra As Range, RowContainsWord As Boolean
    ' ищем и удаляем строки, НЕ содержащие заданный текст
    ' (можно указать сколько угодно значений, и использовать подстановочные знаки)

    Application.ScreenUpdating = False    ' отключаем обновление экрана на время удаления строк
    УдалятьСтрокиСТекстом = Array("AL.M.ME", "Новотранс Юг")
 
    ' перебираем все строки в используемом диапазоне листа
    For Each ra In ActiveSheet.UsedRange.Rows
        RowContainsWord = False
 
        ' перебираем все фразы в массиве
        For Each word In УдалятьСтрокиСТекстом
            ' если в очередной строке листа найден искомый текст
            If Not ra.Find(word, , xlValues, xlPart) Is Nothing Then RowContainsWord = True
        Next word
 
        If RowContainsWord = False 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    ' удаляем их
End Sub

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.