Excel - Bloquear células com base na cor?

Excel - Bloquear células com base na cor?

Eu tenho esta planilha do Excel onde desejo proteger algumas células contra formatação e edição. Todas essas células são coloridas com uma cor específica.

A planilha é muito grande e, portanto, estou procurando uma maneira de bloquear todas essas células de uma só vez e, em seguida, poder formatar em massa todas as outras células sem alterar as células que desejo bloquear.

Existe alguma maneira de dizer ao Excel para bloquear células com uma cor específica?

Responder1

Sim, com VBa... Basta copiar isso para "ThisWorkbook" na tela do Visual Basic e executá-lo (triângulo verde de reprodução)

insira a descrição da imagem aqui

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

Não há como desfazer no VBa, então primeiro faça uma cópia do seu arquivo (para criar um backup)!

Índice de cores -http://dmcritchie.mvps.org/excel/colors.htm

Como adiciono VBA no MS Office?

O texto acima pressupõe que você não tenha células mescladas e que sua planilha não esteja protegida.

Se você não tem certeza de qual é o colorIndex necessário, use este script primeiro

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

Editar

Você mencionou que usa células mescladas

Tente por favor

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

Responder2

eu encontreiessemaneira usando uma macro simples:

Selecione a planilha inteira (Ctrl+A)e desbloqueie todas as células, e então use esta macro para definir as coloridas para serem bloqueadas novamente:

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 

Responder3

Solução Vba (Como adiciono VBA no 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

Responder4

O procedimento abaixo funciona para mim, desde que você desproteja a folha primeiro, o índice de cores está definido como 6 para amarelo.

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

informação relacionada