Excel - Блокировка ячеек на основе цвета?

Question

У меня есть этот лист Excel, где я хочу защитить некоторые ячейки от форматирования и редактирования. Все эти клетки окрашены в определенный цвет.

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

Есть ли способ сказать Excel, чтобы заблокировать ячейки с определенным цветом?

Answer 1

Да, с VBa ... Просто скопируйте это в "ThisWorkbook" на экране Visual Basic и затем запустите его (зеленый игровой треугольник)

Sub WalkThePlank()

    dim colorIndex as Integer
    colorIndex = 3                   'UPDATE ME TO YOUR COLOUR OR BE FED TO THE SHARKS   

    Dim rng As Range

    For Each rng In ActiveSheet.UsedRange.Cells

        Dim color As Long
        color = rng.Interior.ColorIndex
        If (color = colorIndex) Then   
            rng.Locked = True
        else
            rng.Locked = false    'this will remove any locks for those not in the given color
        End If

    Next rng

End Sub

В VBa нет отмены, поэтому сначала сделайте копию вашего файла (чтобы создать резервную копию)!

Цветовой индекс - http://dmcritchie.mvps.org/excel/colors.htm

Как добавить VBA в MS Office?

Вышеприведенное предполагает, что у вас нет объединенных ячеек и что ваш лист не защищен.

Если вы не уверены, какой colorIndex вам нужен, сначала используйте этот скрипт

Sub Find()

Dim colorIndexFinder As Integer
colorIndexFinder = Range("A1").Interior.colorIndex  'CHANGE A1 to the cell with the colour you want to use
MsgBox (colorIndexFinder)

End Sub

---

редактировать

Вы упомянули, что вы используете объединенные ячейки

Пожалуйста, попробуй

Sub WalkThePlank()

Dim colorIndex As Integer
colorIndex = 3                   'UPDATE ME TO YOUR COLOUR OR BE FED TO THE SHARKS

Dim rng As Range

For Each rng In ActiveSheet.UsedRange.Cells

    Dim color As Long
    color = rng.Interior.colorIndex

    If (color = colorIndex) Then
        If (rng.MergeCells) Then
            rng.MergeArea.Locked = True
        Else
            rng.Locked = True
        End If
    Else
        If (rng.MergeCells) Then
            rng.MergeArea.Locked = False
        Else
            rng.Locked = False
        End If
    End If

    Next rng

End Sub

Answer 2

Я нашел этот способ с помощью простого макроса:

Выделите весь лист (Ctrl+A) и разблокируйте все ячейки, а затем используйте этот макрос, чтобы снова установить цветные ячейки:

Dim c As Object 
For Each c In selection 
    If c.ColorIndex = 6 ' 6 is for Yellow - change to the colour you want
    c.Locked = True 
End If 
Next c 

Answer 3

Решение VBA (Как добавить VBA в MS Office?)

Sub LockOnlyCellsWithCertainColor()
    'Change to your color
    Const colorToLock = 65535

    Dim currentCell As Range

    ActiveSheet.Cells.Locked = False

    For Each currentCell In ActiveSheet.UsedRange.Cells
        If currentCell.Interior.Color = colorToLock Then
            If currentCell.MergeCells Then
                currentCell.MergeArea.Locked = True
            Else
                currentCell.Locked = True
            End If
        End If
    Next

End Sub

Sub GetBackgroundColorOfActiveCell()
    Debug.Print ActiveCell.Interior.Color
    MsgBox ActiveCell.Interior.Color
End Sub

Answer 4

Приведенное ниже работает для меня до тех пор, пока вы сначала снимите защиту листа, для индекса цвета установлено значение 6 для желтого цвета.

Sub Lock_by_Color()
Dim colorIndex As Integer
Dim Range As Range

colorIndex = 6
For Each Range In ActiveSheet.UsedRange.Cells
Dim color As Long
 color = Range.Interior.colorIndex
If (color = colorIndex) Then
 Range.Locked = True
Else
 Range.Locked = False
End If
Next Range

ActiveSheet.Protect , DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
ActiveSheet.EnableSelection = xlNoRestrictions
End Sub