Удаление строк по списку условий - Microsoft Office Excel

Ppaa · 18.02.2013, 16:36

Нашел вот такой макрос для удаления с листа строк, содержащих текст.
В имеющемся варианте кол-во условий достаточно ограничено.
Подскажите пожалуйста, как сделать так, чтобы условия были перечислены на следующем листе по одному в строке
Допустим в столбце A

Код:

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

    ' ищем и удаляем строки, содержащие заданный текст
   ' (можно указать сколько угодно значений, и использовать подстановочные знаки)
   УдалятьСтрокиСТекстом = Array("условие1*", "условие2*")

    ' перебираем все строки в используемом диапазоне листа
   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

EducatedFool · 18.02.2013, 16:52

Цитата:

В имеющемся варианте кол-во условий достаточно ограничено.

Неужели?

Если заменить

Код:

УдалятьСтрокиСТекстом = Array("условие1*", "условие2*")

на

Код:

УдалятьСтрокиСТекстом = worksheets(2).range("a1:a2000").value

То условий будет в 1000 раз больше.

Правда, и работать код будет дольше.

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

PS: Если кто не знает, откуда взят код, - то найти его (в разных вариантах) можно у меня на сайте:
http://excelvba.ru/code/ConditionalRowsDeleting

Ppaa · 18.02.2013, 22:06

В примере у вас на сайте этой конструкции не было. Спасибо за подсказку!

roytman · 11.01.2017, 10:24

Добрый день.

Прошу помощи в решении задачи.
Есть таблицы с энным количеством строк и столбцов. Нужен макрос, который проверит наличие указанных слов (перечисляются в макросе) и оставит только строки, в которых встречается хотя бы одно из этих слов. Это основная задача. Макрос под удаление строк, содержащих текст, я нашел. А вот чтобы удалялись наоборот остальные строки - нет.

Вторая задача - дописать этот макрос, чтобы проверял в определенном столбце ячейки на наличие повторов и удалял повторящиеся строки. Т.е. если в этом столбце есть две ячейки со словом Цветок, то ода из строк удаляется. К примеру - вторая. Или первая. Не суть важно.

Заранее большое спасибо.

С уважением, Дмитрий.

Serge_Bliznykov · 11.01.2017, 10:32

Цитата:

Сообщение от roytman

Макрос под удаление строк, содержащих текст, я нашел. А вот чтобы удалялись наоборот остальные строки - нет.

так всё просто.
в этом макросе:
если СтрокаСодержитТекст тогда УдалитьСтроку

переделывайте на
если NOT СтрокаСодержитТекст тогда УдалитьСтроку

и всё.

например,
вот это:

Цитата:

Код:

  If Not ra.Find(word, , xlValues, xlPart) Is Nothing Then

меняете на

Код:

  If ra.Find(word, , xlValues, xlPart) Is Nothing Then

Aleksandr H. · 11.01.2017, 10:41

Цитата:

Сообщение от roytman

Вторая задача - дописать этот макрос, чтобы проверял в определенном столбце ячейки на наличие повторов и удалял повторящиеся строки. Т.е. если в этом столбце есть две ячейки со словом Цветок, то ода из строк удаляется.

стандартное средство удаления дубликатов чем не подходит?

roytman · 11.01.2017, 11:04

Цитата:

Сообщение от Serge_Bliznykov

так всё просто.
в этом макросе:
если СтрокаСодержитТекст тогда УдалитьСтроку

переделывайте на
если NOT СтрокаСодержитТекст тогда УдалитьСтроку

и всё.

например,
вот это:

меняете на

Код:

  If ra.Find(word, , xlValues, xlPart) Is Nothing Then

К сожалению не силен в программировании, можно пояснить для тупых, пожалуйста. Вот код который есть сейчас:

Код:

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

    ' ищем и удаляем строки, содержащие заданный текст
   ' (можно указать сколько угодно значений, и использовать подстановочные знаки)
   УдалятьСтрокиСТекстом = Array("автозапчасти для иномарок*", "условие2*")

    ' перебираем все строки в используемом диапазоне листа
   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

_____
Код программы нужно выделять (форматировать) тегами [CODE] (читать FAQ)
Модератор

roytman · 11.01.2017, 12:51

Цитата:

Сообщение от Serge_Bliznykov

так всё просто.
в этом макросе:
если СтрокаСодержитТекст тогда УдалитьСтроку

переделывайте на
если NOT СтрокаСодержитТекст тогда УдалитьСтроку

и всё.

например,
вот это:

меняете на

Код:

  If ra.Find(word, , xlValues, xlPart) Is Nothing Then

Получилось, однако проверка идет по всем перечисленным значениям. Т.е. в каждой строке должен содержаться весь набор слов, а не какое-то их них. Как это исправить?

Serge_Bliznykov · 11.01.2017, 14:04

Цитата:

Сообщение от roytman

а не какое-то их них. Как это исправить?

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

Код:

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

    ' ищем и удаляем строки, содержащие заданный текст
   ' (можно указать сколько угодно значений, и использовать подстановочные знаки)
   УдалятьСтрокиСТекстом = Array("автозапчасти для иномарок*", "условие2*")

    ' перебираем все строки в используемом диапазоне листа
   For Each ra In ActiveSheet.UsedRange.Rows
        ' перебираем все фразы в массиве
       isFoundAny = False
       For Each word In УдалятьСтрокиСТекстом
            ' если в очередной строке листа найден искомый текст
           If Not ra.Find(word, , xlValues, xlPart) Is Nothing Then
                isFoundAny = True
                Exit For
           End If
        Next word
        If Not isFoundAny Then
           If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
        End If
    Next

    ' если подходящие строки найдены, то: (оставьте одну из 2 следующих строк)
   If Not delra Is Nothing Then delra.EntireRow.Hidden = True    ' скрываем их
   If Not delra Is Nothing Then delra.EntireRow.Delete    ' удаляем их
End Sub

roytman · 11.01.2017, 14:13

Цитата:

Сообщение от Serge_Bliznykov

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

Код:

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

    ' ищем и удаляем строки, содержащие заданный текст
   ' (можно указать сколько угодно значений, и использовать подстановочные знаки)
   УдалятьСтрокиСТекстом = Array("автозапчасти для иномарок*", "условие2*")

    ' перебираем все строки в используемом диапазоне листа
   For Each ra In ActiveSheet.UsedRange.Rows
        ' перебираем все фразы в массиве
       isFoundAny = False
       For Each word In УдалятьСтрокиСТекстом
            ' если в очередной строке листа найден искомый текст
           If Not ra.Find(word, , xlValues, xlPart) Is Nothing Then
                isFoundAny = True
                Exit For
           End If
        Next word
        If Not isFoundAny Then
           If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
        End If
    Next

    ' если подходящие строки найдены, то: (оставьте одну из 2 следующих строк)
   If Not delra Is Nothing Then delra.EntireRow.Hidden = True    ' скрываем их
   If Not delra Is Nothing Then delra.EntireRow.Delete    ' удаляем их
End Sub

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

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Список строк в C++. Сортировка. Поиск по списку.	Alendorff	Помощь студентам	8	16.10.2012 13:55
Удаление строк	chipesca	Microsoft Office Excel	0	06.06.2012 20:05
перенос строк удаление ненужных строк	HelperAwM	Microsoft Office Excel	5	26.06.2010 18:42
Удаление строк по списку файлов	550953	Microsoft Office Excel	7	01.09.2009 10:23
удаление строк	Dime_x	Microsoft Office Excel	2	07.10.2008 13:38

18.02.2013, 22:06	#3
Ppaa Форумчанин Регистрация: 20.12.2010 Сообщений: 107	В примере у вас на сайте этой конструкции не было. Спасибо за подсказку!

11.01.2017, 10:24	#4
roytman Новичок Джуниор Регистрация: 11.01.2017 Сообщений: 4	Добрый день. Прошу помощи в решении задачи. Есть таблицы с энным количеством строк и столбцов. Нужен макрос, который проверит наличие указанных слов (перечисляются в макросе) и оставит только строки, в которых встречается хотя бы одно из этих слов. Это основная задача. Макрос под удаление строк, содержащих текст, я нашел. А вот чтобы удалялись наоборот остальные строки - нет. Вторая задача - дописать этот макрос, чтобы проверял в определенном столбце ячейки на наличие повторов и удалял повторящиеся строки. Т.е. если в этом столбце есть две ячейки со словом Цветок, то ода из строк удаляется. К примеру - вторая. Или первая. Не суть важно. Заранее большое спасибо. С уважением, Дмитрий.