Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Изменение цвета ячеек по условию, кроме уже покрашенных, Помогите доработать макрос.
 
Добрый день. Есть следующий код:
Код
Sub COLOR()
Dim Rng As Range
Dim n
Dim rData
 
'Dim RndMY
    With Worksheets("Заполнять")
        Set Rng = .Range("G:G")
 
        For Each n In Rng
                   
        Select Case n
                Case "сущ"
                     Range(Cells(n.Row, 1), Cells(n.Row, 58)).Interior.ColorIndex = 0
                Case "план"
                     Range(Cells(n.Row, 1), Cells(n.Row, 58)).Interior.ColorIndex = 19
                Case "откл"
                     Range(Cells(n.Row, 1), Cells(n.Row, 58)).Interior.ColorIndex = 15
    
            End Select
        Next n
    End With
End Sub

Этот макрос вызывается с помощью изменения значения ячеек в определенном столбце
Код
If Not Intersect(Target, Range("G:G")) Is Nothing Then
   If Target > 0 Then
     Call COLOR
   End If
 End If

Помогите сделать, так чтобы скрипт не трогал уже закрашенные ячейки пользователем. Пусть красит всё, кроме этих ячеек. Знаю процесс не оптимизирован, но значение в столбцах меняется крайне редко и задержка в 2 секунды на работу макроса устраивает.  
 
...
if not Range(Cells(n.Row, 1), Cells(n.Row, 58)).Interior.Color = 16777215 then
...
Изменено: Ivan.kh - 9 Апр 2019 11:39:48
 
Ivan.kh, мне не удобно Вас просить, но мне кажется нужен код полностью.  :D  
 
Frosted.one, что значит код полностью?
Эту строчку нужно добавить в имеющийся, чтоб не обрабатывало ячейки с заливкой Перед Select'ом, а после него закрыть end if
 

...
Изменено: Михаил Лебедев - 9 Апр 2019 10:46:55 (удалил код)
 
Ivan.kh, не совсем то что нужно.

Необходимо чтобы закрашивалась вся строка, кроме тех ячеек, которые уже закрашены пользователем. С кодом предоставленным Вами - раскраска строки полностью игнорируется при наличии закрашенной ячейки. А надо оставить цвет этой ячейки и покрасить всю строку в необходимый цвет. И выполнение теперь не 2 секунды, а все 20-30.
 
а если просто УФ и макрофункцию
 
Цитата
Frosted.one написал:
Ivan.kh , не совсем то что нужно....надо оставить цвет этой ячейки и покрасить всю строку в необходимый цвет. И выполнение теперь не 2 секунды, а все 20-30.
файл-пример приложите
 
Frosted.one, направление решения Вам показано, кто мешает закраску в цикл вынести?

Код
...
Select Case n
    Case "сущ"
         ci = 0
    Case "план"
         ci = 19
    Case "откл"
         ci = 15

End Select
...

For i = 1 To 58
    If Range(Cells(n.Row, i)).Interior.Color = 16777215 Then Range(Cells(n.Row, i)).Interior.ColorIndex = ci
Next

...
Изменено: Ivan.kh - 9 Апр 2019 11:42:40
 
Код
Sub COLOR()
    Dim Rng As Range
    Dim n
    Dim rData

    'Dim RndMY
    With Worksheets("Заполнять")
        Set Rng = .Range("G:G")

        For Each n In Rng

            Select Case n
            Case "сущ"
                For i = 1 To 58
                    If Cells(n.Row, i).Interior.ColorIndex = xlNone Then Cells(n.Row, i).Interior.ColorIndex = 0
                Next
            Case "план"
                For i = 1 To 58
                    If Cells(n.Row, i).Interior.ColorIndex = xlNone Then Cells(n.Row, i).Interior.ColorIndex = 19
                Next
            Case "откл"
                For i = 1 To 58
                    If Cells(n.Row, i).Interior.ColorIndex = xlNone Then Cells(n.Row, i).Interior.ColorIndex = 15
                Next
            End Select
        Next n
    End With
End Sub

Но на скорость не надейтесь.
Ибо раньше вы совали руку в ящик, и если там есть бумажка, красили все содержимое ящика, то теперь макрос лезет а каждую полку, смотрит, какого цвета там бумажка, и если нужно, то ее красит.
 
RAN, Спасибо огромное, работает +/- так же. Скорость устраивает. То что нужно!

БМВ, Попробовал сделать по вашему подобию - была проблема - почему то руками ячейки не красились. Возможно я что-то в УФ напортачил при переносе.

Всем отозвавшимся огромное-огромное спасибо!  
 
RAN, Может поиграться с блоками  в строке, которые нужно красить и окраске их разом? потом только посмотрел, что гоняется макрос по всему столбцу.

ну и обновление экрана придушить обязательно.

Frosted.one,  если  изменений всего в одной строке, то ваш код запускается по всему столбцу, что и является самым большим тормозом.
нет ни ограничения по области данных, да и проверять то нужно только в строках где значения изменились, а остальные строки не трогать.
Скрытый текст


А лучше
Скрытый текст
Изменено: БМВ - 9 Апр 2019 21:56:48
Страницы: 1
Читают тему (гостей: 1)
Наверх