Страницы: 1
RSS
Удаление строк по двум условиям (Цвет)
 
Добрый день, с цифрами и текстом я аналогичную задачу решал, а с цветами не могу.
В общем в столбце C есть адреса, условным форматированием подсвечеваются дубли(заливка ячейки). Текст не актуальных перекрашиваетя в красный.
Как автоматизировать процесс . Т.Е. по нажатию кнопки удалялась строка, если цвет текста красный, а цвет ячейки "светло-бежевый"(ну или другой)
эксэль 2016

Заранее спасибо.
 
Добрій и Вам. А если применить фильтр по цвету, затем просто удалить то, что отфильтровано?
Если в мире всё бессмысленно, — сказала Алиса, — что мешает выдумать какой-нибудь смысл? ©Льюис Кэрролл
 
Добрый.Попробуйте.
Код
Sub DeleteByFontColor()
    Dim cell As Range
    Application.ScreenUpdating = False
    For Each cell In ActiveSheet.UsedRange.Columns(3).Cells
        If cell.Font.Color = 255 Then cell.EntireRow.Delete
    Next
    Application.ScreenUpdating = True
End Sub
 
amfor,Добрый день, так удаляет если подкрашен шрифт, независимо от заливки. увы работает непонятно то удаляет часть, а часть оставляет, повторно убивает все красные...
Bema,оч. долго, много строк, либо удаляются скрытые, либо если отчищать пустые строки по которым фильтр перестает работать.

Увы пока не реализовано. Но все равно спасибо.
 
Добрый. Не совсем понятно что Вы хотите. Удалить дубли или что?
 
amfor, дубли, но они в хаотичной последовательности, т.е. не всегда нужный сверху, что бы удалять через "поиск дубликатов" по столбцам.
Да и вообще явно можно интерестно же, думаю может этот переделаю
Код
  'удаляем строки по 2м условиям
   
   Dim ra As Range, delra As Range, ТекстДляПоиска As String
    Application.ScreenUpdating = False    ' отключаем обновление экрана

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

    ' перебираем все строки в используемом диапазоне листа
    For Each ra In ActiveSheet.UsedRange.Rows
If ra.Row >= 3 Then
        ' если выполняются одновременно следующие условия целс номер столба 16 и ФТТХ условия

        If ra.Cells(8) > 16 And ra.Cells(24) = "FTTx" Then
           ' добавляем строку в диапазон для удаления

           If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
        End If
End If
    Next
    ' если подходящие строки найдены - удаляем их
    If Not delra Is Nothing Then delra.EntireRow.Delete
 
Цитата
mihail_ms написал:
но они в хаотичной последовательности, т.е. не всегда нужный сверху
В том и дело что какие строки нужно удалять,а какие нет знаете только Вы. Поэтому, что то подсказать сложно.
 
Оптимизация быстродействия макроса по удалению строк
 
amfor, ну как же, известно какие, у тех которых шрифт красный и заливка ячейки цветом (условным форматированием повтор)
 
Для работы с УФ нужно либо проверять выполнение условия, либо использовать DisplayFormat
 
Удалять по УФ - неблагодарное дело, тем более что у Вас дубли подсвечиваются через УФ, а цвет шрифта не актуальных перекрашивается в ручную поэтому
Цитата
amfor написал:
какие строки нужно удалять,а какие нет знаете только Вы
Наверно есть какой то признак отличающий актуальный дубль от неактуального.
 
amfor, есть, но они вне таблицы, поэтому вручную перекрашиваются в красный, а потом в конце месяца удаляются дубли. А то что это дубль показывает УФ. Т.К. бывает красное но не дубль, бывает красное но дубль, бывает дубль но не красное.
От условного форматирования наверное можно уйти перекрасив заливку ячеек дублей, но не уверен что это тот путь.
 
Цитата
mihail_ms написал:
Т.К. бывает красное но не дубль, бывает красное но дубль, бывает дубль но не красное.
Поэтому от УФ и раскрасок нужно уходить и использовать другой способ отметки строк которые нужно удалить.ИМХО
 
amfor, плодить доп столбцы с комментариями? Не информативно и тяжело в повседневной работе (ИМХО)
 
Не видя реальной структуры,трудно что то предложить(может быть достаточно одного доп столбца,который может быть скрытым или находиться на другом листе)
 
amfor,согласен, что подсказать почти нереально. Так то тогда можно и макросом что я писал выше обойтись 2 столбца "слово ключ" и  (1,0), но это костыль.
 
Вроде так только If ra.Row >= 3 Then  , если If ra.Row = 3 Then не работает, влияет на скорость?
Код
Sub DeleteByFontColor2()

'удаляем строки по 2м условиям
    
   Dim ra As Range, delra As Range
   
     ' перебираем все строки в используемом диапазоне листа
    For Each ra In ActiveSheet.UsedRange.Rows
If ra.Row >= 3 Then
        ' если выполняются одновременно следующие условия целс номер 3 шрифт красн и целс номер 3 заливка желтая(УФ)
 
        If ra.Cells(3).Font.Color = 255 And ra.Cells(3).DisplayFormat.Interior.Color = vbYellow Then
           ' добавляем строку в диапазон для удаления
 
           If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
        End If
End If
    Next
    ' если подходящие строки найдены - удаляем их
    If Not delra Is Nothing Then delra.EntireRow.Delete
End Sub
Изменено: mihail_ms - 27.07.2018 11:52:54
 
Цитата
mihail_ms написал:
If ra.Row = 3 Then не работает
Этим Вы проверяете на цвет только 3 строку.  
 
amfor, ой ссори, тупонул , тогда все ок. Готово, кому надо могут пользоваться.
 
Я вот че подумал, а вместо удаления перенос на отдельный лист реализовать можно\сложно?
 
А что делать с ними на этом листе?
 
amfor,складывать в стопочку, т.е. типа архива, добовляются строки и добавляются...
Изменено: mihail_ms - 27.07.2018 13:03:10
 
Я имел ввиду лист с которого нужно переносить. Если удалить то наверно так.
Изменено: amfor - 27.07.2018 13:48:19
 
amfor,типа того , перенос в архив, а в старом удалить , только после нескольких использований ошибка в строке.

Sheets("Архив").Cells(iLastRow, 1).PasteSpecial Paste:=xlPasteValues   это если нечего удалять


А так супер, спасибо огромное.
Изменено: mihail_ms - 27.07.2018 14:46:29
Страницы: 1
Наверх