** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Otros de Microsoft: Windows y Office > Excel
  Mensajes nuevos Mensajes nuevos RSS - VBA, Impedir cambiar datos en celdas.
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

VBA, Impedir cambiar datos en celdas.

 Responder Responder
Autor
Mensaje
hakamin Ver desplegable
Nuevo
Nuevo


Unido: 23/Mayo/2012
Localización: España
Estado: Sin conexión
Puntos: 38
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita hakamin Cita  ResponderRespuesta Enlace directo a este mensaje Tema: VBA, Impedir cambiar datos en celdas.
    Enviado: 23/Julio/2019 a las 10:31
Buenas chicos.

Tengo una hoja excel con unas 400 celdas (combinadas de diferentes tamaños) que simulan una excavación arqueológica.

Cuando en una de esas celdas pongo un "1" se ponen de un color, con un "2" de otro, y asi hasta el "5".

Hay celdas que solo pueden ir con el número "1" y otras solo con el resto "2-3-4-5". La idea es conseguir que en las celdas que SOLO pueden tener un "1" de alguna forma se impida meter otro número o si se hace que se borre.

Para las celdas que solo admiten el "1" he usado este código que avisa que no se puede poner ese número y borra el contenido.

Private Sub Worksheet_Change(ByVal Target As Range)

    If Range("BH4") > "1" Then
        MsgBox "Esta excavación no permite este código. Insertar 1"
        Range("BH4:BH5").ClearContents
    ElseIf Range("BJ4") > "1" Then
        MsgBox "Esta excavación no permite este código"
        Range("BJ4:BJ5").ClearContents
    ElseIf Range("BL4") > "1" Then
        MsgBox "Esta excavación no permite este código"
        Range("BL4:BL5").ClearContents

End If
End Sub

Y para las celdas solo admiten el "2-3-4-5" este otro código.

    ElseIf Range("BH6") = "1" Then
        MsgBox "Esta excavación no permite este código. Inserta 2, 3, 4 o 5"
        Range("BH6:bH10").ClearContents
    ElseIf Range("BJ6") = "1" Then
        MsgBox "Esta excavación no permite este código. Inserta 2, 3, 4 o 5"
        Range("BJ6:bJ10").ClearContents

Alguna otra solución? ya que hacer esto por cada celda es una currada.

Las celdas combinadas donde solo puede ir el "1" son de dos celdas A1:A2 por ejemplo y las otras son de 5 celdas A3:A7.

Gracias.
Arriba
pitxiku Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 27/Septiembre/2017
Localización: En mi casa
Estado: Sin conexión
Puntos: 1076
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita pitxiku Cita  ResponderRespuesta Enlace directo a este mensaje Enviado: 23/Julio/2019 a las 15:53
¿Y usar la validación de datos? Seleccionas todas las celdas, vas a validación de datos e indicas los valores permitidos. Con hacerlo una vez para cada tipo de validación es suficiente, y sin una línea de código:

- https://support.office.com/es-es/article/Aplicar-la-validación-de-datos-a-celdas-29fecbcc-d1b9-42c1-9d76-eff3ce5f7249
Arriba
lbauluz Ver desplegable
Administrador
Administrador
Avatar

Unido: 29/Marzo/2005
Localización: Binghamton
Estado: Sin conexión
Puntos: 3418
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita lbauluz Cita  ResponderRespuesta Enlace directo a este mensaje Enviado: 23/Julio/2019 a las 20:37
Una opción, si ya tienes los colores puestos.

Mira si el color es rojo (o el color que sea cuando es nivel 1) y si lo es, pones "a pelo" el 1

Para hacer esto en la hoja  (NO en un modulo) pon esto:

Sub Worksheet_Change(ByVal Target As Range)
    If (Target.Interior.Color = 255) Then ´Rojo
        Target.Value = 1
    End If
End Sub
Estos son mis principios. Si no le gustan... tengo otros
Arriba
prga Ver desplegable
Moderador
Moderador


Unido: 16/Noviembre/2004
Localización: España
Estado: Sin conexión
Puntos: 3206
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita prga Cita  ResponderRespuesta Enlace directo a este mensaje Enviado: 23/Julio/2019 a las 20:52
Hola.
Otra alternativa es utilizar un código similar al siguiente:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Select Case ActiveCell.MergeArea.Cells.Count
 Case 1
  MsgBox ("estamos en una celda sin agrupar con valor--" & Target.Cells(1).Value)
 Case 2
  MsgBox ("estamos en una agrupación de 2 celdas con valor--" & Target.Cells(1).Value)

 Case 5
  MsgBox ("estamos en una agrupación de 5 celdas con valor--" & Target.Cells(1).Value)

  Case Else
  MsgBox ("estamos en una situación diferente a las anteriores con valor--" & Target.Cells(1).Value)

End Select
End Sub

Espero que ayude a resolver la duda
Un saludo a todos
Arriba
AnSanVal Ver desplegable
Administrador
Administrador
Avatar

Unido: 16/Marzo/2005
Localización: España
Estado: Sin conexión
Puntos: 5488
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita AnSanVal Cita  ResponderRespuesta Enlace directo a este mensaje Enviado: 24/Julio/2019 a las 11:31
Otra opción.

Supongo que también sería un problema que a un rango 3 (ya establecido) alguien (por error) lo cambie a rango 5, con el consiguiente cambio de formato. Para evitar esto yo  «juego» con el color de la fuente y con el color del fondo:


 ·  Fuente 1 = RGB(1,1,1)

 ·  Fuente 2 = RGB(2,2,2)

 ·  Fuente 3 = RGB(3,3,3)

 ·  Fuente 4 = RGB(4,4,4)

 ·  Fuente 5 = RGB(5,5,5) 


 ·  AC1:AG1  =   65793, 131586, 197379, 263172 y 328965  (son los tonos de fuente).


Los cinco son tonos de negro que (a nivel humano) no se diferencian, mediante el tono de fuente (el código) «impide» que se alteren  los valores.


Con este código (en un módulo ordinario) obtienes los rangos de AA1:AA22, ...

Sub Macro2()

  Dim f&

  With Range("AA1:AA2")

    .MergeCells = True

    .Font.color = RGB(1, 1, 1)

    Range("AA1").Value = 1

  End With

    For f = 3 To 18 Step 5

    With Cells(f, "AA").Resize(5)

      .MergeCells = True

      .Font.color = RGB((f + 7) / 5, (f + 7) / 5, (f + 7) / 5)

      .HorizontalAlignment = xlCenter

      .VerticalAlignment = xlCenter

      Cells(f, "AA").Value = (f + 7) / 5

    End With

  Next f

End Sub

...  con sus correspondientes colores de fuente. Aplícale manualmente los colores de relleno que prefieras.


 · Cuando necesites  (por ejemplo) un rango 4, selecciona AA13:AA17, das a copiar y pegas en destino (B13:B17).

 ·  Si cambias el color de uno de los rangos origen, en destino permanecen sin cambio hasta que re-escribas su valor, solo aceptará el que le pertenece por color de fuente.


En el módulo de la hoja:

Private Sub Worksheet_Change(ByVal Target As Range)

  Dim i#, fuente$

  On Error Resume Next

  fuente = Target.Font.color

  i = WorksheetFunction.Match(Target.Font.color, Range("AC1:AG1"))

  Application.EnableEvents = False

  Select Case i

    Case 1 To 5 ' fuente con tonos negros especiales.

      Target.Value = i

      Target.Interior.color = Range("AA1").Offset(i * 5 - 5).Interior.color

  End Select

  Application.EnableEvents = True

End Sub



Aprendemos viendo respuestas de otros, también intentando resolver dudas (intenta ayudar cuando puedas/sepas).

Mi sitio_web con ejemplos Excel.
Arriba
AnSanVal Ver desplegable
Administrador
Administrador
Avatar

Unido: 16/Marzo/2005
Localización: España
Estado: Sin conexión
Puntos: 5488
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita AnSanVal Cita  ResponderRespuesta Enlace directo a este mensaje Enviado: 24/Julio/2019 a las 11:52
Aquí un enlace con el ejemplo.



Aprendemos viendo respuestas de otros, también intentando resolver dudas (intenta ayudar cuando puedas/sepas).

Mi sitio_web con ejemplos Excel.
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable