Снова нужна Ваша помощь. Искал по темам, не сумел найти того, что мне нужно.
Задача такова:
Есть таблица. Ее нужно очистить от ненужных строк. Все ненужные строки по колонке А окрашены в какой-либо цвет (не УФ). Все неокрашенные ячейки в столбце А нужно оставить. Макрос, должен, соответственно, быть таким: сканируем Интервал А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 и до последней заполненной. Ну в коде это есть в общем.
Заполните любую ячейку столбца А (где-нибудь ниже таблицы) - это будет последняя строка, которую будет просматривать макрос, потом выполните этот код:
Код
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
Юрий М, спасибо большое за макрос. Но, он слегка некорректно выполняет задачу. Дело в том, что все ячейки в оригнальном файле заполнены текстовой информацией. Вложение обновил. Если запустить МАКРОС он удаляет все строки, даже незаполненные, такие как "IMPORTANT" в примере. Оставляет он в итоге только строки с "X" и пустые с датами.
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 ))
Юрий М, во-первых, спасибо большое за код. Работает корректно. Во-вторых, чего ж Вы такой строгий-то а? ))) Я не волшебник я только учусь ))) Исправимся. )