Подсветка незащищенных ячеек

Если вы когда-нибудь использовали защиту ячеек на листе (вкладка Рецензирование - Защитить лист или в старых версиях Excel - меню Сервис - Защита - Защитить лист), то, возможно, сталкивались с этой проблемой. Как известно, будет данная конкретная ячейка на листе защищена от изменений после включения защиты листа, или нет - определяется галочкой Защищаемая ячейка (Locked) в диалоговом окне Формат ячейки (Format Cells) на вкладке Защита (Protection):

highlight-unprotected1.png

В случае применения защиты листа к большой и сложной таблице или экранной форме, где должно быть много областей ввода, не всегда понятно - у каких ячеек на листе эта галочка уже выключена, а у каких еще осталась включена? Опубликованные ниже макросы как раз и позволяют включить/выключить подсветку цветом для незащищенных ячеек на текущем листе, чтобы их было наглядно видно.

Для добавления этих макросов в текущую книгу:

  • нажмите сочетание клавиш ALT+F11, чтобы открыть редактор макросов Visual Basic
  • вставьте новый пустой модуль в книгу, используя команду меню Insert - Module
  • скопируйте и вставьте туда код приведенных ниже макросов
Public Fills
Sub Unprotected_Cells_Show()
    Application.ScreenUpdating = False
    ReDim Fills(1 To ActiveSheet.UsedRange.Rows.Count, 1 To ActiveSheet.UsedRange.Columns.Count)
    For Each cell In ActiveSheet.UsedRange
        If cell.Interior.ColorIndex = -4142 Then
            Fills(cell.Row, cell.Column) = 0
        Else
            Fills(cell.Row, cell.Column) = cell.Interior.Color
        End If
        If Not cell.Locked Then cell.Interior.ColorIndex = 3
    Next cell
    Application.ScreenUpdating = True
End Sub

Sub Unprotected_Cells_Hide()
    Application.ScreenUpdating = False
    For Each cell In ActiveSheet.UsedRange
        If Fills(cell.Row, cell.Column) = 0 Then
            cell.Interior.ColorIndex = -4142
        Else
            cell.Interior.Color = Fills(cell.Row, cell.Column)
        End If
    Next cell
    Application.ScreenUpdating = True
End Sub

Как легко догадаться, первый из этих двух макросов включает подсветку красным для незащищенных ячеек, а второй - выключает ее, восстанавливая исходный цвет заливки. Запустить эти макросы можно, нажав сочетание клавиш ALT+F8 или воспользовавшись кнопкой Макросы (Macros) на вкладке Разработчик (Developer).

Работа макроса на примере экранной формы выглядит примерно так:

highlight-unprotected2.png

И не надо ломать голову и проверять - где ты снял защиту с ячеек, а где она осталась.

Ссылки по теме

 


04.04.2013 09:24:56
Пример не работает выдает ошибку. Когда заходишь в макрос выделяет "cell.Interior.ColorIndex = 3"
11.04.2013 09:11:30
Мой пример - работает.
У вас же, возможно, УЖЕ стоит защита листа - снимите ее сначала.
07.05.2013 15:24:36
Не работает, такая же ошибка. Причем как на собственном примере, так и во вложенном файле
01.07.2013 00:29:44
У меня тоже выдает ошибку. Когда заходишь в макрос выделяет "Sub Unprotected_Cells_Hide()" желтым цветом.
01.07.2013 20:26:07
Сначала нужно снять защиту листа. На защищенном листе макрос работать не может.
02.07.2013 10:10:43
Спасибо Николай. Все получилось.
02.12.2013 08:02:35
Николай, при применении показа незащищенных ячеек  два раза подряд, скрытие уже не работает.
Т.е. применил 1 раз показ не защищенных(их залило красным), потом применил еще раз показ(по запарке), после применяю скрыть(заливка должна пропасть) и ничего. Все так же и остается залитым красным.
Защита листа отключена, версия excell 2010
02.12.2013 20:21:06
Так и должно быть, к сожалению, ибо макрос при повтором запуске записал в массив Fills (куда сохраняется исходный цвет ячеек для восстановления) красный цвет.
04.12.2013 17:19:34
Николай, а можно как нить это дело обойти? По хорошему макрос то полезный весьма, но эта неприятность сводит на нет пользу.
03.09.2015 12:25:42
А если так?

Public Fills
Public flag As Boolean

Sub Unprotected_Cells_Show()
    Application.ScreenUpdating = False
    If Not flag Then
        ReDim Fills(1 To ActiveSheet.UsedRange.Rows.Count, 1 To ActiveSheet.UsedRange.Columns.Count)
        For Each cell In ActiveSheet.UsedRange
            If cell.Interior.ColorIndex = -4142 Then
                Fills(cell.Row, cell.Column) = 0
            Else
                Fills(cell.Row, cell.Column) = cell.Interior.Color
            End If
            If Not cell.Locked Then
                cell.Interior.ColorIndex = 3
                flag = True
            End If
        Next cell
    End If
    Application.ScreenUpdating = True
End Sub

Sub Unprotected_Cells_Hide()
    Application.ScreenUpdating = False
    For Each cell In ActiveSheet.UsedRange
        If Fills(cell.Row, cell.Column) = 0 Then
            cell.Interior.ColorIndex = -4142
        Else
            cell.Interior.Color = Fills(cell.Row, cell.Column)
            flag = False
        End If
    Next cell
    Application.ScreenUpdating = True
End Sub
 
или вообще, повесить всё это действо на один макрос/кнопку на ribbon:

Public Fills
Public flag As Boolean
Sub Unprotected_Cells()
    Application.ScreenUpdating = False
    If Not flag Then
     lastrow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
        lastcolumn = ActiveSheet.UsedRange.Column + ActiveSheet.UsedRange.Columns.Count - 1
        ReDim Fills(1 To lastrow, 1 To lastcolumn)
        For Each cell In ActiveSheet.UsedRange
            If cell.Interior.ColorIndex = -4142 Then
                Fills(cell.Row, cell.Column) = 0
            Else
                Fills(cell.Row, cell.Column) = cell.Interior.Color
            End If
            If Not cell.Locked Then
                cell.Interior.ColorIndex = 3
            End If
        Next cell
        flag = True
    Else
        For Each cell In ActiveSheet.UsedRange
            If Fills(cell.Row, cell.Column) = 0 Then
                cell.Interior.ColorIndex = -4142
            Else
                cell.Interior.Color = Fills(cell.Row, cell.Column)
            End If            
        Next cell   
        flag = False
    End If
    Application.ScreenUpdating = True
End Sub
03.08.2016 16:25:27
Вот так
Sub Unprotected_Cells_Show()
Dim Fills As Variant
Application.ScreenUpdating = False
ReDim Fills(1 To ActiveSheet.UsedRange.Rows.Count, 1 To ActiveSheet.UsedRange.Columns.Count)
For Each cell In ActiveSheet.UsedRange
If Not cell.Locked Then cell.Interior.ColorIndex = 3
Next cell
Application.ScreenUpdating = True
End Sub



Sub Unprotected_Cells_Hide()
Dim Fills As Variant
Application.ScreenUpdating = False
ReDim Fills(1 To ActiveSheet.UsedRange.Rows.Count, 1 To ActiveSheet.UsedRange.Columns.Count)
For Each cell In ActiveSheet.UsedRange
If Not cell.Locked Then cell.Interior.ColorIndex = -4142
Next cell
Application.ScreenUpdating = True
End Sub
07.01.2017 12:24:49
А зачем вы здесь объявляете "Fills".
В дальнейшем же не используется?
29.03.2019 14:16:13
Дима , спасибо с вашим вариантом макроса у меня не вываливаются ошибки Run-time error 9: subscript out of range
по строчке: Fills(cell.Row, cell.Column) = 0
Спасибо!

при том что на одном компе имеется два экселя и в одном работает этот макрос а в другом нет. Я так и не понял в чем была проблема(в кодах не шарю), но применив ваш вариант получилось использовать данную возможность.

Единственный нюанс: по вашему макросу он убирает цвет заливки полность по команде hide , в отличие от варианта автора.

Еще попробовал вариант из этогосообщения, второй вариант, после этого текста:
действо на один макрос/кнопку на ribbon
и теперь работает как надо. Спасибо , heso .
29.03.2019 12:20:58
Сергей Юкос, я думаю что вас также как и меня затрудняет снимать защиту с каждого листа, рекомендую всем кто такой же как и я лентяй применить plex , там есть пакетная блокировка\разблокировка листов и этот вопрос легко решается.
kpk
09.12.2013 19:11:22
А можно как-то сделать: лист должен быть защищен.
И тот кто его заполняет видел эти незащищенные ячейки, те чтобы они были выделены цветом, но при печати этот цвет чтобы не печатался.
Просто есть лист, которые печатаются и нужно видеть какие ячейки заполнять.
02.07.2015 14:17:13
Добрый день!
У меня такая ситуация: данный макрос работает просто отлично на 9 листах из 10 (как пример), но на 10-ом листе данный макрос (показать незащищенные ячейки) отказывается работать выдает ошибку (Run-time error 9: subscript out of range) и ругается на эту строчку Fills(cell.Row, cell.Column) = cell.Interior.Color. В чем может быть причина?
Справочно: лист не защищен, на листе есть ниспадающий список созданный через Данные - Проверка данных - Список. Также есть условное форматирование, но опытным путем установлено, что данный макрос работает с условным форматированием на других листах.
26.03.2016 15:59:45


Какой библиотеки не хватает в 13 excell ?
Процедура не запускается.
Жалуется   на For Each celll In ActiveSheet.UsedRange
14.03.2017 12:11:07
почему выдает ошибку на строку "If Fills(cell.Row, cell.Column) = 0 Then" если пытаюсь повесить запуск данных макросов на кнопку ?
и еще вопрос: как сделать что б макрос перебирал все листы книги и делал данные процедуры на всех листах?
спасибо.
17.06.2017 21:35:16
Дорого времени суток!
Скопировал полностью в чистый файл .xlsb,  лист не защищен, спецом пару ячеек незащищенных сделал.
В общем сделал все по инструкции в новом тестовом файле.
Выдает ошибку:  Fills(cell.Row, cell.Column) = 0
Если удалить Public Fills, то ошибки  "Fills(cell.Row, cell.Column) = 0"  уже нет, страничку раскрасит как должно.
Но скрытие не работает выделяет ошибку: Can't execute in breake mode   и желтым выделена строчку:  Sub Unprotected_Cells_Hide()

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

Пока не знаю, как это реализовать)
25.12.2021 19:03:43
Макрос выдаёт ошибку "Run-time error '13': Type mismatch"
Защиту листов выключил
Модуль положил в "VBAProject (PERSONAL>XLSB)"
25.12.2021 19:41:32
Я выполнил сначала 1 макрос, потом 2-ой - всё заработало, так что в этом проблема снята.
Но есть второй вопрос.
У меня в таблице используются ячейки с красными цветами, как поменять в макросе отображение с красного на например голубой?

Заметил такую вещь, если запустить макрос проверки защищённых ячеек и перейти на другой лист, так же проверить защищаемые ячейки и снова перейти на предыдущий лист, то снять выделение защищаемых ячеек не получится - макрос не срабатывает.
26.10.2022 13:19:53
Sub Выделить_все_НЕзаблокированные_ячейки()
Dim cel As Range
Dim Rng As Range

Set Rng = Nothing
On Error GoTo Pipec
For Each cel In ActiveSheet.UsedRange
   If cel.Locked = False Then
       If Rng Is Nothing Then
           Set Rng = cel
       Else
           Set Rng = Union(Rng, cel)
       End If
   End If
Next

If Rng Is Nothing Then
   MsgBox "НЕзаблокированных ячеек" & vbCrLf & "НЕ НАЙДЕНО.", 64, "В Н И М А Н И Е !"
Else
   Rng.Select
End If
Exit Sub
Pipec:
MsgBox "Слишком большой диапазон." & vbCrLf & "Выделение ВСЕХ НЕзаблокированных ячеек невозможно.", 16, "В Н И М А Н И Е !"
End Sub
Наверх