Как заблокировать изменение условного форматирования ячеек? - Мир MS Excel

Регистрация

Напомнить пароль

= Мир MS Excel/Как заблокировать изменение условного форматирования ячеек? - Мир MS Excel

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Как заблокировать изменение условного форматирования ячеек? (Формулы/Formulas)

Как заблокировать изменение условного форматирования ячеек?

Дата: Пятница, 01.06.2018, 12:38 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 15

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

Добрый день уважаемые форумчане!
Прошу помощи в решении вопроса:
Есть таблица, в которую постоянно добавляются данные. Это делается по средствам макроса и для более простого поиска несоответствий было применено условное форматирование о цвету, с заранее большим количеством обрабатываемых ячеек. Т.е. если последние данные находятся в ячейке A200, то условное форматирование применено к ячейкам А1:А300, что бы добавляемые данные автоматически обрабатывались условным форматированием.
Однако через какое-то время в списке диспетчера правил условного форматирования появляются дубликаты ранее созданных условий, при этом они могут быть применены к абсолютно разным ячейкам в столбце.

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

П.с. Поиск я прошуршал, но ответа так и не нашел.

Ответить

Дата: Пятница, 01.06.2018, 12:47 | Сообщение № 2

Группа: Админы

Ранг: Местный житель

Сообщений: 16771

Репутация: 6551 ±

Замечаний: ±

2003; 2007; 2010; 2013 RUS

1. Привыкнуть все данные вставлять только через Спецвставка - Значение (можно вывести кнопку на панель быстрого доступа)
2. Написать макрос, который следил бы за УФ-ом. Но для этого нужен Ваш файл (кусочек) и пояснялку к нему
3. Вообще убрать УФ и поиск несоответствий делать макросом. Но для этого нужен Ваш файл (кусочек) и пояснялку к нему

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

Ответить

Дата: Пятница, 01.06.2018, 13:07 | Сообщение № 3

Группа: Пользователи

Ранг: Новичок

Сообщений: 15

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

Цитата _Boroda_, 01.06.2018 в 12:47, в сообщении № 2 ()

1. Привыкнуть все данные вставлять только через Спецвставка - Значение (можно вывести кнопку на панель быстрого доступа)

Данные вставляются по средствам вот такого макроса:
[vba]

Код

'Выделяем и вставляем скопированные данные в последнюю ячейку
Worksheets("Dr_Op_log").Cells(EmptyRow, "B").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

[/vba]

Как я понимаю, условие Paste:=xlPasteValues - как раз и является спецвставкой - только значения.

В файлик вставил кусок таблицы с правильно заданными условиями.
Вставить "плохой" кусок (с кучей повторяющихся УФ) не получилось из за большого размера файла.

К сообщению приложен файл: Example.xls (31.5 Kb)

Ответить

Дата: Пятница, 01.06.2018, 13:36 | Сообщение № 4

Группа: Авторы

Ранг: Старожил

Сообщений: 1161

Репутация: 103 ±

Замечаний: 0% ±

Excel 2010

Можно просто тот же макрос заставить принудительно распространять УФ на нужную область при изменении листа, а не заливать её УФ заранее...

Интуитивно понятный код - это когда интуитивно понятно, что это код.

Ответить

Дата: Пятница, 01.06.2018, 13:37 | Сообщение № 5

Группа: Админы

Ранг: Местный житель

Сообщений: 16771

Репутация: 6551 ±

Замечаний: ±

2003; 2007; 2010; 2013 RUS

Цитата alex_07, 01.06.2018 в 13:07, в сообщении № 3 ()

условие Paste:=xlPasteValues - как раз и является спецвставкой - только значения

Совершенно верно, но могу предположить, что ниже есть еще строки с копированием формата из ячеек выше. Приложите весь код. Если большой, то можно в файле

Цитата StoTisteg, 01.06.2018 в 13:36, в сообщении № 4 ()

тот же макрос заставить принудительно распространять УФ на нужную область

Именно про это я и писа

Цитата _Boroda_, 01.06.2018 в 12:47, в сообщении № 2 ()

2. Написать макрос, который следил бы за УФ-ом.

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

Ответить

Дата: Пятница, 01.06.2018, 13:42 | Сообщение № 6

Группа: Друзья

Ранг: Ветеран

Сообщений: 562

Репутация: 167 ±

Замечаний: 0% ±

365

выполните данный код после вставки значений

[vba]

Код

Option Explicit

Sub macros1()

Dim EndRow&
With ActiveSheet
    .Cells.FormatConditions.Delete  'очистит старые форматы
    EndRow = .Cells(.Rows.Count, 1).End(xlUp).Row   'найдет последнюю строку в 1-й колонке

    'ваше усл.форматирование записанное макрорекодером и с моей не болшой правкой

    With .Range("Q4:Q" & EndRow).FormatConditions.Add(Type:=xlCellValue, Operator:=xlLess, Formula1:="=8880*0,95")
        .StopIfTrue = False
        With .Interior
            .PatternColorIndex = xlAutomatic
            .Color = 26367
            .TintAndShade = 0
        End With
    End With

    With .Range("E4:E" & EndRow).FormatConditions.AddUniqueValues
        .DupeUnique = xlDuplicate
        .StopIfTrue = False
        With .Font
            .Color = -16383844
            .TintAndShade = 0
            .ThemeFont = xlThemeFontNone
        End With
        With .Interior
            .PatternColorIndex = xlAutomatic
            .Color = 13551615
            .TintAndShade = 0
        End With
    End With

    With .Range("G4:G" & EndRow).FormatConditions.Add(Type:=xlCellValue, Operator:=xlLess, Formula1:="=7,7+0,9")
        .StopIfTrue = False
        With .Interior
            .PatternColorIndex = xlAutomatic
            .Color = 8420607
            .TintAndShade = 0
        End With
    End With

    With .Range("R4:S" & EndRow).FormatConditions.Add(Type:=xlExpression, Formula1:="=LEN(TRIM(RC))=0")
        .StopIfTrue = False
        With .Interior
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent2
            .TintAndShade = -0.249946592608417
        End With
    End With

End With
End Sub

[/vba]

выполните данный код после вставки значений

[vba]

Код

Option Explicit

Sub macros1()

Dim EndRow&
With ActiveSheet
    .Cells.FormatConditions.Delete  'очистит старые форматы
    EndRow = .Cells(.Rows.Count, 1).End(xlUp).Row   'найдет последнюю строку в 1-й колонке

    'ваше усл.форматирование записанное макрорекодером и с моей не болшой правкой

    With .Range("Q4:Q" & EndRow).FormatConditions.Add(Type:=xlCellValue, Operator:=xlLess, Formula1:="=8880*0,95")
        .StopIfTrue = False
        With .Interior
            .PatternColorIndex = xlAutomatic
            .Color = 26367
            .TintAndShade = 0
        End With
    End With

    With .Range("E4:E" & EndRow).FormatConditions.AddUniqueValues
        .DupeUnique = xlDuplicate
        .StopIfTrue = False
        With .Font
            .Color = -16383844
            .TintAndShade = 0
            .ThemeFont = xlThemeFontNone
        End With
        With .Interior
            .PatternColorIndex = xlAutomatic
            .Color = 13551615
            .TintAndShade = 0
        End With
    End With

    With .Range("G4:G" & EndRow).FormatConditions.Add(Type:=xlCellValue, Operator:=xlLess, Formula1:="=7,7+0,9")
        .StopIfTrue = False
        With .Interior
            .PatternColorIndex = xlAutomatic
            .Color = 8420607
            .TintAndShade = 0
        End With
    End With

    With .Range("R4:S" & EndRow).FormatConditions.Add(Type:=xlExpression, Formula1:="=LEN(TRIM(RC))=0")
        .StopIfTrue = False
        With .Interior
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent2
            .TintAndShade = -0.249946592608417
        End With
    End With

End With
End Sub

[/vba]boa

Сообщение отредактировал boa - Пятница, 01.06.2018, 14:15

Ответить

Сообщениевыполните данный код после вставки значений

[vba]

Код

Option Explicit

Sub macros1()

Dim EndRow&
With ActiveSheet
    .Cells.FormatConditions.Delete  'очистит старые форматы
    EndRow = .Cells(.Rows.Count, 1).End(xlUp).Row   'найдет последнюю строку в 1-й колонке

    'ваше усл.форматирование записанное макрорекодером и с моей не болшой правкой

    With .Range("Q4:Q" & EndRow).FormatConditions.Add(Type:=xlCellValue, Operator:=xlLess, Formula1:="=8880*0,95")
        .StopIfTrue = False
        With .Interior
            .PatternColorIndex = xlAutomatic
            .Color = 26367
            .TintAndShade = 0
        End With
    End With

    With .Range("E4:E" & EndRow).FormatConditions.AddUniqueValues
        .DupeUnique = xlDuplicate
        .StopIfTrue = False
        With .Font
            .Color = -16383844
            .TintAndShade = 0
            .ThemeFont = xlThemeFontNone
        End With
        With .Interior
            .PatternColorIndex = xlAutomatic
            .Color = 13551615
            .TintAndShade = 0
        End With
    End With

    With .Range("G4:G" & EndRow).FormatConditions.Add(Type:=xlCellValue, Operator:=xlLess, Formula1:="=7,7+0,9")
        .StopIfTrue = False
        With .Interior
            .PatternColorIndex = xlAutomatic
            .Color = 8420607
            .TintAndShade = 0
        End With
    End With

    With .Range("R4:S" & EndRow).FormatConditions.Add(Type:=xlExpression, Formula1:="=LEN(TRIM(RC))=0")
        .StopIfTrue = False
        With .Interior
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent2
            .TintAndShade = -0.249946592608417
        End With
    End With

End With
End Sub

[/vba]

Автор - boa
Дата добавления - 01.06.2018 в 13:42

Дата: Пятница, 01.06.2018, 13:43 | Сообщение № 7

Группа: Авторы

Ранг: Старожил

Сообщений: 1161

Репутация: 103 ±

Замечаний: 0% ±

Excel 2010

Цитата _Boroda_, 01.06.2018 в 13:37, в сообщении № 5 ()

Именно про это я и писа

Так для этого не нужен сам макрос, просто на событие Change вешаем применение УФ к нужным областям UsedRange...

Интуитивно понятный код - это когда интуитивно понятно, что это код.

Ответить

Дата: Пятница, 01.06.2018, 13:48 | Сообщение № 8

Группа: Авторы

Ранг: Старожил

Сообщений: 1161

Репутация: 103 ±

Замечаний: 0% ±

Excel 2010

Цитата boa, 01.06.2018 в 13:42, в сообщении № 6 ()

выполните данный код после вставки значений

А ещё лучше — обзовите его[vba]

Код

Private Sub Worksheet_Change(ByVal Target As Range)

[/vba]и повесьте в модуль листа

Интуитивно понятный код - это когда интуитивно понятно, что это код.

Ответить

Дата: Пятница, 01.06.2018, 14:24 | Сообщение № 9

Группа: Админы

Ранг: Местный житель

Сообщений: 16771

Репутация: 6551 ±

Замечаний: ±

2003; 2007; 2010; 2013 RUS

Цитата StoTisteg, 01.06.2018 в 13:43, в сообщении № 7 ()

на событие Change вешаем

Цитата StoTisteg, 01.06.2018 в 13:48, в сообщении № 8 ()

А ещё лучше — обзовите его
[vba]

Код

Private Sub Worksheet_Change(ByVal Target As Range)

[/vba]
и повесьте в модуль листа

Чем лучше? Тем, что при каждом изменении на листе будет этот макрос запускаться?

Все правильно boa написал:

Цитата boa, 01.06.2018 в 13:42, в сообщении № 6 ()

выполните данный код после вставки значений

Не всегда это можно так просто сделать, именно поэтому я и написал выше

Цитата _Boroda_, 01.06.2018 в 13:37, в сообщении № 5 ()

Приложите весь код

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

Ответить

Дата: Пятница, 01.06.2018, 14:32 | Сообщение № 10

Группа: Друзья

Ранг: Ветеран

Сообщений: 562

Репутация: 167 ±

Замечаний: 0% ±

365

StoTisteg,
Не самая лучшая идея вешать УФ на событие листа
попробуйте поиграться с УФ на дубликаты в столбце на 100 тыс. значений(добавить/удалить, а для полноты ощущений еще и отфильтровать).
Excel будет постоянно висеть, стоит вам в какой-то ячейке правку сделать :).
выполнять данный код нужно разово, после вставки значений и не перегружать Ехсе1 не нужными действиями. или повесить на кнопку типа "Обновить форматирование"

Ответить

Дата: Пятница, 01.06.2018, 14:40 | Сообщение № 11

Группа: Авторы

Ранг: Старожил

Сообщений: 1161

Репутация: 103 ±

Замечаний: 0% ±

Excel 2010

boa, тоже верно.

Интуитивно понятный код - это когда интуитивно понятно, что это код.

Ответить

Дата: Пятница, 01.06.2018, 14:54 | Сообщение № 12

Группа: Пользователи

Ранг: Новичок

Сообщений: 15

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

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

[vba]

Код

Sub Export_Well_Dr_Log()

Dim Lastrow As String
Dim EmptyRow As String

'Имя файла журналов
Workbooks("Data Analysis File.rev3.4.xlsm").Activate
Name_log = Worksheets("import").Cells(10, "E").Value
'Скопировать нужный диапазон в открывшейся книге на листе 1
Worksheets("Output_Well-drill & inj").Activate
Worksheets("Output_Well-drill & inj").Range("B7:Y199").Copy

'Активируем нужную нам книгу
Workbooks(Name_log).Activate
Worksheets("Well_Dr_Log").Activate
'Worksheets("LB of well-dril and inject").Activate

'     Расчет количества строк импортируемого файла
'---------------------------------------------------------

    Lastrow = Worksheets("Well_Dr_Log").Cells(Rows.Count, 2).End(xlUp).Row
    'Lastrow = Worksheets("LB of well-dril and inject").Cells(Rows.Count, 2).End(xlUp).Row

'    Определить первую пустую строку для которого будут записаны данные
'---------------------------------------------------------

    EmptyRow = Worksheets("Well_Dr_Log").Cells(Rows.Count, 2).End(xlUp).Row + 1
    'EmptyRow = Worksheets("LB of well-dril and inject").Cells(Rows.Count, 2).End(xlUp).Row + 1

'Выделяем и вставляем скопированные данные в последнюю ячейку
Worksheets("Well_Dr_Log").Cells(EmptyRow, "B").Select
'Worksheets("LB of well-dril and inject").Cells(EmptyRow, "B").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Workbooks(Name_log).Activate

End Sub

[/vba]

Ответить

СообщениеСпасибо большое за ответы.
Ниже прикладываю весь код импорта
Прошу сильно не бить, писал по учебнику для чайников и гугля.

[vba]

Код

Sub Export_Well_Dr_Log()

Dim Lastrow As String
Dim EmptyRow As String

'Имя файла журналов
Workbooks("Data Analysis File.rev3.4.xlsm").Activate
Name_log = Worksheets("import").Cells(10, "E").Value
'Скопировать нужный диапазон в открывшейся книге на листе 1
Worksheets("Output_Well-drill & inj").Activate
Worksheets("Output_Well-drill & inj").Range("B7:Y199").Copy

'Активируем нужную нам книгу
Workbooks(Name_log).Activate
Worksheets("Well_Dr_Log").Activate
'Worksheets("LB of well-dril and inject").Activate

'     Расчет количества строк импортируемого файла
'---------------------------------------------------------

    Lastrow = Worksheets("Well_Dr_Log").Cells(Rows.Count, 2).End(xlUp).Row
    'Lastrow = Worksheets("LB of well-dril and inject").Cells(Rows.Count, 2).End(xlUp).Row

'    Определить первую пустую строку для которого будут записаны данные
'---------------------------------------------------------

    EmptyRow = Worksheets("Well_Dr_Log").Cells(Rows.Count, 2).End(xlUp).Row + 1
    'EmptyRow = Worksheets("LB of well-dril and inject").Cells(Rows.Count, 2).End(xlUp).Row + 1

'Выделяем и вставляем скопированные данные в последнюю ячейку
Worksheets("Well_Dr_Log").Cells(EmptyRow, "B").Select
'Worksheets("LB of well-dril and inject").Cells(EmptyRow, "B").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Workbooks(Name_log).Activate

End Sub

[/vba]

Автор - alex_07
Дата добавления - 01.06.2018 в 14:54

Дата: Пятница, 01.06.2018, 15:03 | Сообщение № 13

Группа: Авторы

Ранг: Старожил

Сообщений: 1161

Репутация: 103 ±

Замечаний: 0% ±

Excel 2010

Ну да. А теперь забросьте в отдельный макрос код boa, обзовите его, например,
[vba]

Код

Sub ReFormat()

[/vba]
и в конец Вашего кода —
[vba]

Код

Call ReFormat

[/vba]

Интуитивно понятный код - это когда интуитивно понятно, что это код.

Ответить

Дата: Пятница, 01.06.2018, 15:07 | Сообщение № 14

Группа: Админы

Ранг: Местный житель

Сообщений: 16771

Репутация: 6551 ±

Замечаний: ±

2003; 2007; 2010; 2013 RUS

С этим кодом относительно несанкционированного размножения УФ все в порядке. Значит или есть еще какой-то код (копирование строк или что-то еще) или Вы вручную копируете/вставляете какие-то ячейки (или строки) на этом листе.
Тогда код boa, засунутый в этот макрос, не поможет. И

Цитата StoTisteg, 01.06.2018 в 15:03, в сообщении № 13 ()

в конец Вашего кода —
[vba]

Код

Call ReFormat

[/vba]

тоже не поможет. Макрос boa все поправит, а Вы потом снова испортите. Тогда нужно или вешать макрос на кнопку, или на сохранение книги, или на активацию листа, или ..., или смотреть все макросы, которые есть у Вас в книге. Или, если макросов больше нет, то сознавайтесь, что ручками делаете

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

Ответить

Дата: Пятница, 01.06.2018, 15:53 | Сообщение № 15

Группа: Авторы

Ранг: Старожил

Сообщений: 1161

Репутация: 103 ±

Замечаний: 0% ±

Excel 2010

_Boroda_, вот и я из тех же соображений предлагал на событие. Но насчёт Change Вы с boa правы, а вот сохранение — это мысль.

Интуитивно понятный код - это когда интуитивно понятно, что это код.

Ответить

Дата: Суббота, 02.06.2018, 07:28 | Сообщение № 16

Группа: Пользователи

Ранг: Новичок

Сообщений: 15

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

Цитата _Boroda_, 01.06.2018 в 15:07, в сообщении № 14 ()

если макросов больше нет, то сознавайтесь, что ручками делаете

Точно сказать не могу, в этом файле далеко не один я работаю, от того и нужно было как-то заблокировать.

Цитата boa, 01.06.2018 в 14:32, в сообщении № 10 ()

повесить на кнопку типа "Обновить форматирование"

А вот эта идея интересная, да и вполне рабочая. Нажать раз в неделю кнопку при заполнении данных - не такое уж сложное дело.

Спасибо!

Ответить

Как заблокировать изменение условного форматирования ячеек? (Формулы/Formulas)

Страница 1 из 1
1

© 2010-2025 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!