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

Способ первый:
Использовать встроенное средство Excel - фильтр. Сначала его необходимо "установить" на листе:

  • Выделяем таблицу с данными, включая заголовки. Если их нет - то выделяем с самой первой строки таблицы, в которой необходимо удалить данные
  • устанавливаем фильтр:
    • для Excel 2003: Данные-Фильтр-Автофильтр
    • для Excel 2007-2010: вкладка Данные(Data) -Фильтр(Filter)(или вкладка Главная(Home) -Сортировка и фильтр(Sort&Filter) -Фильтр(Filter))

Теперь выбираем условие для фильтра:

  • в Excel 2003 надо выбрать Условие и в появившейся форме выбрать непосредственно условие("равно", "содержит", "начинается с" и т.д.), а напротив значение в соответствии с условием.
  • Для 2007-2010 Excel нужно выбрать Текстовые фильтры(Text Filters) и либо сразу выбрать одно из предлагаемых условий, либо нажать Настраиваемый фильтр(Custom Filter) и ввести значения для отбора в форме

После этого удалить отфильтрованные строки. В 2007 Excel могут возникнуть проблемы с удалением отфильтрованных строк, поэтому рекомендую сначала так же прочитать статью: Excel удаляет вместо отфильтрованных строк - все?! Как избежать.

 
Способ второй:
применить код VBA, который потребует только указания значения, которое необходимо найти в строке и номер столбца, в котором искать значение.

Sub Del_SubStr()
    Dim sSubStr As String 'искомое слово или фраза(может быть указанием на ячейку)
    Dim lCol As Long      'номер столбца с просматриваемыми значениями
    Dim lLastRow As Long, li As Long
    Dim lMet As Long
    Dim arr
 
    sSubStr = InputBox("Укажите значение, которое необходимо найти в строке", "www.excel-vba.ru", "")
    If sSubStr = "" Then lMet = 0 Else lMet = 1
    lCol = Val(InputBox("Укажите номер столбца, в котором искать указанное значение", "www.excel-vba.ru", 1))
    If lCol = 0 Then Exit Sub
 
    lLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
    arr = Cells(1, lCol).Resize(lLastRow).Value
    Application.ScreenUpdating = 0
    Dim rr As Range
    For li = 1 To lLastRow 'цикл с первой строки до конца
        If -(InStr(arr(li, 1), sSubStr) > 0) = lMet 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
    Application.ScreenUpdating = 1
End Sub

Как использовать: Для начала надо убедиться, что разрешены макросы и при необходимости включить их: почему не работает макрос. Затем копируем код выше, из Excel переходим в редактор VBA(Alt+F11 или вкладка Разработчик(Developer) -Visual Basic) -Insert -Module. Вставляем туда скопированный код. Теперь код можно вызывать нажатием клавиш Alt+F8 -выделяем Del_SubStr -Выполнить(Run).
Если значение sSubStr не будет указано, то будут удалены строки, ячейки указанного столбца которых, пустые.
Если в данном коде в строке If -(InStr(Cells(li, 1), sSubStr) > 0) = lMet Then
вместо = lMet указать <> lMet, то удаляться будут наоборот строки, не содержащие указанное для значение. Иногда тоже удобно.
Но. Данный код просматривает строки на предмет частичного совпадения указанного значения. Например, если Вы укажете текст для поиска "отчет", то будут удалены все строки, в которых встречается это слово("квартальный отчет", "отчет за месяц" и т.д.). Это не всегда нужно. Поэтому ниже приведен код, который будет удалять только строки, указанные ячейки которых равны конкретно указанному значению:

Sub Del_SubStr()
    Dim sSubStr As String 'искомое слово или фраза(может быть указанием на ячейку)
    Dim lCol As Long 'номер столбца с просматриваемыми значениями
    Dim lLastRow As Long, li As Long
    Dim arr
 
    sSubStr = InputBox("Укажите значение, которое необходимо найти в строке", "www.excel-vba.ru", "")
    lCol = Val(InputBox("Укажите номер столбца, в котором искать указанное значение", "www.excel-vba.ru", 1))
    If lCol = 0 Then Exit Sub
 
    lLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
    arr = Cells(1, lCol).Resize(lLastRow).Value
 
    Application.ScreenUpdating = 0
    Dim rr As Range
    For li = 1 To lLastRow 'цикл с первой строки до конца
        If CStr(arr(li, 1)) = 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
    Application.ScreenUpdating = 1
End Sub

Здесь так же, как и в случае с предыдущим кодом можно заменить оператор сравнения(Cells(li, lCol) = sSubStr) с равно на неравенство(Cells(li, lCol) <> sSubStr) и тогда удаляться будут строки, значения ячеек которых не равно указанному.

УДАЛЕНИЕ СТРОК НА ОСНОВАНИИ СПИСКА ЗНАЧЕНИЙ(МНОЖЕСТВЕННЫЕ КРИТЕРИИ)
Иногда бывают ситуации, когда необходимо удалить строки не по одному значению, а по нескольким. Например, если строка содержит или Итог или Отчет. Ниже приведен код, при помощи которого можно удалить строки, указав в качестве критерия диапазон значений.
Значения, которые необходимо найти и удалить перечисляются на листе с именем "Лист2". Т.е. указав на "Лист2" в столбце А(начиная с первой строки) несколько значений - они все будут удалены. Если лист называется иначе(скажем "Соответствия") в коде необходимо будет "Лист2" заменить на "Соответствия". Удаление строк происходит на активном в момент запуска кода листе. Это значит, что перед запуском кода надо перейти на тот лист, строки в котором необходимо удалить.

Sub Del_Array_SubStr()
    Dim sSubStr As String    'искомое слово или фраза
    Dim lCol As Long    'номер столбца с просматриваемыми значениями
    Dim lLastRow As Long, li As Long
    Dim avArr, lr As Long
    Dim arr
 
    lCol = Val(InputBox("Укажите номер столбца, в котором искать указанное значение", "www.excel-vba.ru", 1))
    If lCol = 0 Then Exit Sub
    Application.ScreenUpdating = 0
    lLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
    'заносим в массив значения листа, в котором необходимо удалить строки
    arr = Cells(1, lCol).Resize(lLastRow).Value
    'Получаем с Лист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)
        For li = 1 To lLastRow 'цикл с первой строки до конца
            If CStr(arr(li, 1)) = sSubStr Then
                If rr Is Nothing Then
                    Set rr = Cells(li, 1)
                Else
                    Set rr = Union(rr, Cells(li, 1))
                End If
            End If
            DoEvents
        Next li
        DoEvents
    Next lr
    If Not rr Is Nothing Then rr.EntireRow.Delete
    Application.ScreenUpdating = 1
End Sub

Чтобы код выше удалял строки не по точному совпадению слов, а по частичному(например, в ячейке записано "Привет, как дела?", а в списке есть слово "привет" - надо удалить, т.к. есть слово "привет"), то надо строку:

If CStr(arr(li, 1)) = sSubStr Then

заменить на такую:

If InStr(1, arr(li, 1), sSubStr, 1) > 0 Then

УДАЛЕНИЕ ИЗ ЛИСТА СТРОК, КОТОРЫХ НЕТ В СПИСКЕ ЗНАЧЕНИЙ(МНОЖЕСТВЕННЫЕ КРИТЕРИИ)
Т.к. в последнее время стало поступать все больше и больше вопросов как не удалять значения по списку, а наоборот - оставить в таблице только те значения, которые перечислены в списке - решил дополнить статью и таким кодом.
Значения, которые необходимо оставить перечисляются на листе с именем "Лист2". Т.е. указав на "Лист2" в столбце А(начиная с первой строки) несколько значений - после работы кода на листе будут оставлены только те строки, в которых присутствует хоть одно из перечисленных в списке значений. Если лист называется иначе(скажем "Соответствия") в коде необходимо будет "Лист2" заменить на "Соответствия". Удаление строк происходит на активном в момент запуска кода листе. Это значит, что перед запуском кода надо перейти на тот лист, строки в котором необходимо удалить.
В отличие от приведенных выше кодов, данный код ориентирован на то, что значения в списке указаны не полностью. Т.е. если необходимо оставить только те ячейки, в которых встречается слово "активы", то в списке надо указать только это слово. В этом случае если в ячейке будет записана фраза "Нематериальные активы" или "Активы сторонние" - эти ячейки не будут удалены, т.к. в них встречается слово "активы". Регистр букв при этом неважен.

'процедура оставляет в листе только те значения, которые перечислены в списке
Sub LeaveOnlyFoundInArray()
    Dim sSubStr As String   'искомое слово или фраза
    Dim lCol As Long        'номер столбца с просматриваемыми значениями
    Dim lLastRow As Long, li As Long
    Dim avArr, lr As Long
    Dim arr
    Dim IsFind As Boolean
 
    lCol = Val(InputBox("Укажите номер столбца, в котором искать указанное значение", "www.excel-vba.ru", 1))
    If lCol = 0 Then Exit Sub
    Application.ScreenUpdating = 0
    lLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
    'заносим в массив значения листа, в котором необходимо удалить строки
    arr = Cells(1, lCol).Resize(lLastRow).Value
    'Получаем с Лист2 значения, которые надо удалить в активном листе
    With Sheets("Лист2") 'Имя листа с диапазоном значений на удаление
        avArr = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
    End With
    'удаляем
    Dim rr As Range
    For li = 1 To lLastRow 'цикл с первой строки таблицы до конца
        IsFind = False
        For lr = 1 To UBound(avArr, 1) 'цикл по списку значений на удаление
            sSubStr = avArr(lr, 1)
            If InStr(1, arr(li, 1), sSubStr, 1) > 0 Then
                IsFind = True
            End If
            DoEvents
        Next lr
        'если значение таблицы не найдено в списке - удаляем строку
        If Not IsFind Then
            If rr Is Nothing Then
                Set rr = Cells(li, 1)
            Else
                Set rr = Union(rr, Cells(li, 1))
            End If
        End If
        DoEvents
    Next li
    If Not rr Is Nothing Then rr.EntireRow.Delete
    Application.ScreenUpdating = 1
End Sub

Чтобы код выше сравнивал значения таблицы со значениями списка по точному совпадению слов, а не по частичному, то надо строку:

If InStr(1, arr(li, 1), sSubStr, 1) > 0 Then

заменить на такую:

If CStr(arr(li, 1)) = sSubStr Then

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

If Not rr Is Nothing Then rr.EntireRow.Delete

заменить на такую:

If Not rr Is Nothing Then rr.EntireRow.Hidden = True

По умолчанию все коды начинают просмотр строк с первой по последнюю заполненную на листе. И если необходимо удалять строки не с первой или не по последнюю, то надо внести корректировки в эту строку:

For li = 1 To lLastRow 'цикл с первой строки до конца

1 - это первая строка; lLastRow - определяется автоматически кодом и равна номеру последней заполненной строки на листе. Если надо начать удалять строки только с 7-ой строки(например, в первых 6-ти шапка), то код будет выглядеть так:

For li = 7 To lLastRow 'цикл с седьмой строки до конца

А если надо удалять только с 3-ей по 300-ю, то код будет выглядеть так:

For li = 3 To 300 'цикл с третьей строки до трехсотой

Так же см.:
Что такое макрос и где его искать?
Что такое модуль? Какие бывают модули?
Как создать кнопку для вызова макроса на листе
Удаление всех пустых строк в таблице
Удаление пустых столбцов на листе
Установить Быстрый фильтр
Фильтр

Loading

152 комментария

  1. Большое спасибо за отличную работу. Подскажите пожалуйста по коду с множ. критериями, каким образом задать критерий для удаления и пустых строк также?

          1. Здравствуйте!
            Можно ли заказать макрос по удалению лишних строк?
            Нужно в большом списке оставить количество строк, указанное в отдельной колонке, для каждого артикула.
            Т.е. удалить лишние строки у каждого артикула, оставив только определенное кол-во строк.
            Это связано с присвоением QR-кодов артикулам.

          2. Добрый день.
            Пришлите запрос на почту: info@excel-vba.ru. Желательно с кратким описанием, примером исходных данных и ориентировочным примером результата.

  3. Спасибо, здорово помола данная статья. Возник вопрос: а можно ли удалить строки с заполненными любыми данными ячейкой столбца. То есть не по списку, а по наличию в них данных (а с пустыми ячейками оставить)?

    1. Toivo, если речь про удаление строк в конкретном указанном столбце, в ячейке которого есть хоть какое-то значение, то нужно заменить эту строку:

      If sSubStr = "" Then lMet = 0 Else lMet = 1

      такой:

      lMet = 1

  4. Добрый день. Макрос работает отлично, огромное спасибо. Однако возникает переодически проблема. После запуска процесс затягивается очень на долго. В среднем у меня в массиве 1000-1500 строк. Условий, которые нужно найти и удалить, около 1000. Обычно процесс удаления занимал около 2 минут. Но иногда после запаска макроса через час ничего не происходит. Какие могут быть дополнительные условия для корректной работы макроса? Может форматы искомых ячеек или формат файла?

    1. Андрей, если раньше все работало быстро, то вывод прост: что-то случилось с файлом. Поищите на сайте статью про "файл тормозит". Там я приводил рекомендации по возможным причинам.

  5. Подскажите, в чем может быть причина, если макрос возвращает ошибку в строке If Not rr Is Nothing Then rr.EntireRow.Delete, а именно подсвечивает rr.EntireRow.Delete и ошибка звучит как "Метод delete из класса Range завершен неверно". Проверил каждый символ, пошагово и вот именно на команде rr.EntireRow.Delete выбивает ошибку. Подозреваю, что что-то не с макросом, а с переполнением массива может быть, но как его почистить или.... Это лишь догадки.. Заранее спасибо!

    1. Сергей, сложно сказать что-то наверняка. Да, возможно и слишком много данных. Тогда подход надо менять и строку If Not rr Is Nothing Then rr.EntireRow.Delete использовать внутри цикла с проверкой, вроде

      If Not rr Is Nothing Then
if rr.Areas.Count >= 50 Then
rr.EntireRow.Delete
set rr = Nothing
End if
End If

      1. Доброго времени. Использую макрос для множественного критерия.
        Имеется база от 20 иногда до 150 тыс., строк. Как бы ускорить ваш макрос? Работает по 10 минут, результат не выдает. т.к., и условий поиска очень много. Не подскажите?

        1. Александр, здесь уже нужно достаточно серьезно перерабатывать код. Используемый в коде Union довольно медленный при большом кол-ве ячеек. Приемы по ускорению есть, но они значительно усложняют код и его понимание. Если будет время и желание - постараюсь выложить более "шустрый" вариант. Но следует так же понимать, что при столь объемной таблице даже само удаление отобранных строк может занимать тоже немалое время и имело бы смысл посмотреть в сторону реализации иными методами. Например, тот же расширенный фильтр с последующей отметкой нужных строк, сортировкой и удалением единого массива. Это максимально быстрый вариант на мой взгляд.

          1. Доброе утро. Спасибо за ответ.
            Подскажите, в моей задаче имеет место быть, поиск и удаление из 150 тыс., строк около 200 уникальных значений, по которым нужно список удалять. И он будет пополнятся со временем, т.е., сегодня нужно найти 200 уникальных значений, а через месяц их может стать 250
            Я сам подумал о фильтрации и удалении, когда вчера изучал методы. Только не умею добавлять список уникальных значений из столбца. Например как в этом случае
            #Dim TestArray as Variant
            TestArray =sheets("Лист2").Range("A1:A1000").Value
            в этом коде я указал, массив уникальных значений. Но вот под Фильтр не смогу прописать массив.

          2. Александр, Вам лучше задать свой вопрос на форуме. Здесь по одному описанию предоставить хоть какое-то конкретное решение нереально. Только с правилами форума не забудьте ознакомиться. Спасибо.

          3. Второй раз регистрируюсь, но модератор так и не написал ответа)

  6. Добрый день.
    Подскажите пожалуйста, возможно ли удалить строку, имеющую определенное значение вместе со строками, находящимися сверху или снизу искомой строки?

  7. Помогите пожалуйста, есть таблица с 1000 строк (указана ссылка и информация которую нужно найти по ней). Сейчас в таргет хантере отфильтровал эту таблицу и получил второй список из 600 строк (которые есть в первом списке) Вопрос, как мне удалить из первого списка строки с ссылками, которых нет во втором списке? Спасибо!

  8. Имеется массив данных, если в определённом столбце есть значение 0, то нужно удалить 3 строки(найденую и соседние) Как изменить макрос для данной работы?

    1. Максим, для начала нужно понять, что значит соседние: выше или ниже? А потом применить методы Offset или Resize(или и то и другое) к найденной строке. Ниже пример для занесения со смещением вниз:

      If rr Is Nothing Then
    Set rr = Cells(li, 1).Resize(3)
Else
    Set rr = Union(rr, Cells(li, 1).Resize(3))
End If

  10. Добрый день.
    Подскажите, пожалуйста, как удалить из таблицы строки, отвечающие следующим требованиям:
    Если значение в столбце 1 строки N принадлежит массиву значений (есть определенный перечень из 12-15 значений, можно сделать список этих значений отдельным столбцом в этой же таблице), то в случае, если значение из столбца 2 строки N этой же таблицы также принадлежит этому же массиву значений, то строку удаляем.
    Другими словами, есть таблица со списком авиарейсов, из которой нужно удалить внутренние рейсы (рейсы внутри одной страны, столбец 1 - аэропорт вылета, столбец 2 - аэропорт прилета).

Добавить комментарий

Этот сайт использует Akismet для борьбы со спамом. Узнайте, как обрабатываются ваши данные комментариев.