Страницы: 1
RSS
Удаление всех закрашенных строк по столбцу А через ВБА, Выделить целиком все строки по критерию закрашенности ячеки в столбце А
 
Здравствуйте, друзья!

Снова нужна Ваша помощь. Искал по темам, не сумел найти того, что мне нужно.

Задача такова:

Есть таблица. Ее нужно очистить от ненужных строк. Все ненужные строки по колонке А окрашены в какой-либо цвет (не УФ). Все неокрашенные ячейки в столбце А нужно оставить. Макрос, должен, соответственно, быть таким: сканируем Интервал А1:A1000 например, ищем все что равно какому-либо цвету, кроме без цвета, затем выделяет целую строку и удаляем. В общем-то вполне тривиальная задача. Есть аналогичный код, которые удаляет пустые строки, надо его чуть подправить, чтоб удалял по цветным ячейкам.
Код
Sub DeleteEmptyRows()

Dim ws As Excel.Worksheet
Dim LastRow As Long

Set ws = ActiveSheet
LastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
With ws.Range("A7:A" & LastRow)
    If WorksheetFunction.CountBlank(.Cells) > 0 Then        ' вот в эти строках полагаю надо что-то изменить типа .Interior.Color <> 0 
        .SpecialCells(xlCellTypeBlanks).EntireRow.Delete    ' или Blank (какой код для незакрашенных ячеек?
    End If
End With

End Sub

Пример по вложении. Заранее всем спасибо за советы.

P.S. в данном примере после работы Макроса должны сохраниться строки А7:A8 и А22:A25  + A30:A31 и A52:A57. Сканировать столбец А можно с ячейки А7 и до последней заполненной. Ну в коде это есть в общем.
Изменено: Paul Zealand - 01.12.2018 08:06:32
 
Paul Zealand, код следует оформлять соответствующим тегом. Ищите такую кнопку (см. скрин) и исправьте своё сообщение.
 
Цитата
Юрий М написал:
Paul Zealand , код следует оформлять соответствующим тегом. Ищите такую кнопку (см. скрин) и исправьте своё сообщение.
Исправил. Спасибо. Больше не повториться! )
Изменено: Paul Zealand - 01.12.2018 07:08:36
 
Заполните любую ячейку столбца А (где-нибудь ниже таблицы) - это будет последняя строка, которую будет просматривать макрос, потом выполните этот код:
Код
Sub Macro1()
Dim DelRa As Range, rCell As Range, LastRow As Long
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    For Each rCell In Range("A7:A" & LastRow)
        If rCell.Interior.ColorIndex <> xlNone Then
            If DelRa Is Nothing Then
                Set DelRa = rCell
            Else
                Set DelRa = Union(DelRa, rCell)
            End If
        End If
    Next
    If Not DelRa Is Nothing Then DelRa.EntireRow.Delete
End Sub
 
И не нужно меня цитировать: зачем в #3 цитата?
 
Юрий М, спасибо большое за макрос. Но, он слегка некорректно выполняет задачу. Дело в том, что все ячейки в оригнальном файле заполнены текстовой информацией. Вложение обновил. Если запустить МАКРОС он удаляет все строки, даже незаполненные, такие как "IMPORTANT" в примере. Оставляет он в итоге только строки с "X" и пустые с датами.
Изменено: Paul Zealand - 01.12.2018 07:40:01
 
Цитата
Paul Zealand написал:
Дело в том, что все ячейки в оригнальном файле заполнены текстовой информацией.
Нет: дело в том, что Вы не следуете правилам:

Цитата
2.3. Приложите файл(ы) с примером (общим весом не более 300Кб) в реальной структуре и форматах данных того, что есть сейчас и того, что хотелось бы на выходе.
В Вашем файле никакой "текстовой информации" не было. Только заливка.
И заодно вопрос к Вам: если нужно удаление строк, то почему в названии темы не про удаление, а про выделение?
 
Юрий М, в примере не заполнил строки текстовой информацией по ошибке. Моя вина. Признаю. Исправился. Уже приложил обновленный пример в прошлом сообщении. Впредь буду внимательнее. С темой опять виноват, я полагал, что если мне подскажут, как выделить все эти строки, то уж удалить дальше по коду я смогу самостоятельно. Я стараюсь следовать правилам, иногда, могу пропустить что-то по невнимательности и неопытности. Прошу сильно не ругать. Буду исправляться.
 
А теперь расскажите, какие строки должны быть удалены во втором примере?
 
Юрий М, после работы Макроса должны сохраниться строки А7:A8 и А22:A25  + A30:A31 и A52:A57. Текст в каждой из оставшихся ячеек каждый раз будет разным. Не всегда там будет "X" и "IMPORTANT".
 
Paul Zealand, мой макрос работает правильно. Просто всё дело в том, что те ячейки, которые Вы считаете незакрашенными, на самом деле залиты "белым". Установите в этих ячейках "Нет заливки" и запустите макрос - останутся именно те строки, которые Вы перечислили.
 
Юрий М, а можно подправить макрос тогда так, чтобы он оставлял еще и строки с белой заливкой? Потому что вручную снять с них цвет будет крайне проблематично, таких строк будет больше 10,000. Пока я сниму с них цвет уже на пенсию выйду.
 
Код
Sub Macro1()
Dim DelRa As Range, rCell As Range, LastRow As Long
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    For Each rCell In Range("A7:A" & LastRow)
        If rCell.Interior.Color <> 16777215 Then
            If DelRa Is Nothing Then
                Set DelRa = rCell
            Else
                Set DelRa = Union(DelRa, rCell)
            End If
        End If
    Next
    If Not DelRa Is Nothing Then DelRa.EntireRow.Delete
End Sub

 
Подводим итоги:
1. Название темы некорректное.
2. Первый пример без нужных данных.
3. Код не оформлен тегом.
4. Ненужное цитирование.
5. Ошибка с заливкой ячеек.
===
Косяк на косяке.
Резюме: предлагается поменять ник на Paul Kosyakov ))
 
Юрий М, во-первых, спасибо большое за код. Работает корректно. Во-вторых, чего ж Вы такой строгий-то а? ))) Я не волшебник я только учусь ))) Исправимся. )
 
Цитата
Paul Zealand написал:
Пока я сниму с них цвет уже на пенсию выйду.
Вам на пенсию через 5 минут?
Поставить фильтр, удалить заливку, снять фильтр. 5 минут должно вполне хватить.
 
Да не строгий я )) Заканчиваю работу, настроение отличное :)
 
RAN, там таблица огромная со всякими объединенными ячейками и прочими нюансами, поверьте Автофильтр в данном случае не лучший помощник. )

Юрий М, вот допилю макрос и тоже заканчиваю работу. И сделаю это быстрее благодаря Вам. Спасибо еще раз. Хороших выходных.
Страницы: 1
Наверх