Excel: ¿bloquear celdas según el color?

Excel: ¿bloquear celdas según el color?

Tengo esta hoja de Excel donde quiero proteger algunas celdas para que no se formatee ni se edite. Todas estas celdas están coloreadas con un color específico.

La hoja es muy grande y, por lo tanto, estoy buscando una manera de bloquear todas estas celdas de una vez y luego poder formatear en masa todas las demás celdas sin cambiar las celdas que quiero bloquear.

¿Hay alguna forma de decirle a Excel que bloquee las celdas con un color específico?

Respuesta1

Sí, con VBa... Simplemente copie esto en "ThisWorkbook" en la pantalla de Visual Basic y luego ejecútelo (triángulo de reproducción verde)

ingrese la descripción de la imagen aquí

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

No se puede deshacer en VBa, ¡así que primero tome una copia de su archivo (para crear una copia de seguridad)!

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

¿Cómo agrego VBA en MS Office?

Lo anterior supone que no tiene celdas fusionadas y que su hoja de trabajo no está protegida.

Si no está seguro de cuál es el índice de color que necesita, utilice este script primero

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

Has mencionado que utilizas celdas combinadas.

Por favor, inténtalo

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

Respuesta2

he encontradoestemanera usando una macro simple:

Seleccione toda la hoja (Ctrl+A)y desbloquee todas las celdas, y luego use esta macro para configurar las de color para que se bloqueen nuevamente:

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 

Respuesta3

solución vba (¿Cómo agrego VBA en 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

Respuesta4

Lo siguiente me funciona siempre que primero desprotejas la hoja y el índice de color esté configurado en 6 para el amarillo.

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

información relacionada