EXCEL. Proteger celdas con datos (Modificar sólo vacías)
Mi pregunta creo que es sencilla: tengo una hoja Excel con datos. Diariamente voy metiendo más datos. Los nuevo datos se pueden introducir en cualquier fila o columna, no tienen por qué ir añadiéndose al final. Puede ser que haya metido algo en la fila 10, pero mañana tengo que abrir la hoja y meter algún dato en una celda de la fila 5 que estaba vacía (por ej)
Lo que NO QUIERO es que los datos que he ido introduciendo puedan ser modificarlos por error. No son filas o columnas concretas. Hablo de DATOS. Es decir, que sólo me permita escribir en las celdas que estén VACÍAS y que si intento escribir en las que tienen datos no me deje, pero que no tenga que estar diariamente protegiendo esas celdas con datos; que sea algo automático.
No sé si me explico…
¿Es posible?
2 Respuestas
LO CONSEGUÍ! Maravilloso... se pone la siguiente macro:
Private Sub Worksheet_Change(ByVal Target As Range)
'Proteger celdas
'Por. Dam
If Not Intersect(Target, Range("A1:V1000")) Is Nothing Then
Application.ScreenUpdating = False
Set Rango = Range("A1:V1000")
ActiveSheet.Unprotect
For Each celda In Rango.Cells
celda.Select
If celda = "" Then
Selection.Locked = False
Selection.FormulaHidden = False
Else
Selection.Locked = True
Selection.FormulaHidden = False
End If
Next
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Application.ScreenUpdating = False
End If
End Sub
El único problema que tengo es el siguiente: que si le das a DESBLOQUEAR no te pide contraseña. ¿Cómo puedo añadir la contraseña "123" por ej dentro de esta fórmula? Es lo único que me falta para que sea PERFECTA.
H o l a:
Te regreso la macro con el password "123"
Private Sub Worksheet_Change(ByVal Target As Range)
'Proteger celdas
'Por. Dante Amor
If Not Intersect(Target, Range("A1:V1000")) Is Nothing Then
Application.ScreenUpdating = False
Set Rango = Range("A1:V1000")
ActiveSheet.Unprotect "123"
For Each celda In Rango.Cells
celda.Select
If celda = "" Then
Selection.Locked = False
Selection.FormulaHidden = False
Else
Selection.Locked = True
Selection.FormulaHidden = False
End If
Next
ActiveSheet.Protect "123", DrawingObjects:=True, Contents:=True, Scenarios:=True
Application.ScreenUpdating = False
End If
End SubPero me parece que la actualización con esa macro es muy lenta, prueba con la siguiente macro:
Private Sub Worksheet_Change(ByVal Target As Range)
'Proteger celdas
'Por. Dante Amor
If Not Intersect(Target, Range("A1:V1000")) Is Nothing Then
ActiveSheet.Unprotect "123"
For Each c In Target
If c = "" Then
c.Locked = False
Else
c.Locked = True
End If
Next
ActiveSheet.Protect "123", DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
End Sub
Ante todo MUCHAS GRACIAS. He podido ponerle contraseña para el desbloqueo. GENIAL!
En cuanto a la segunda macro: es cierto que la primera tiene retraso; se nota un cierto retraso notable. Pero la segunda no funciona; es decir: cuando escribo se bloquea. Pero del todo. No puedo seguir escribiendo en otra celda. Y eso no es lo que busco: en la primera macro no me permite escribir en las que ya tienen valores. Es decir: escribo algo, se bloquea pero puedo escribir en las que están vacías. Las que ya tienen datos están BLOQUEADAS.
Una lástima ese "retraso" que se nota notablemente al escribir de una celda a otra. Si pudiéramos quitarlo seria PERFECTO. Aun así, con lo que me ha costado encontrar la solución, estoy contenta.
MUCHISIMAS GRACIAS A TODOS. Sois unos cracks.
NOTA. Si alguien consigue que funcione sin ese "retraso" ya sería la leche.
RAQUEL
H o l a:
Prueba con la siguiente macro
Private Sub Worksheet_Change(ByVal Target As Range)
'Proteger celdas
'Por. Dante Amor
Set rango = Range("A1:V1000")
If Not Intersect(Target, rango) Is Nothing Then
Application.ScreenUpdating = False
ActiveSheet.Unprotect "123"
On Error Resume Next
rango.SpecialCells(xlCellTypeBlanks).Locked = False
rango.SpecialCells(xlCellTypeConstants, 23).Locked = True
rango.SpecialCells(xlCellTypeFormulas, 23).Locked = True
ActiveSheet.Protect "123", DrawingObjects:=True, Contents:=True, Scenarios:=True
Application.ScreenUpdating = False
End If
End Sub‘
S a l u d o s . D a n t e A m o r (Dam). Recuerda valorar la respuesta. G r a c i a s