Macros para bloquear celdas + botón

[Gelaaauski]

Hola pueden ayudarme con pequeño ejercicio de Excel que también se refiere a bloquear celdas especificas y pueda hacer esto con una macro quisiera que al momento de escribir en la celda D3 las celdas D5, D7, D9 queden bloqueadas o si escribo en la celda D9 las celdas D7, D5y D3 queden bloqueadas, de igual manera con las celdas D7 y D5. No se si me explico

ISC 1.xlsx

[Antoni]

Imagino que lo que pretendes es que solo pueda informarse un solo valor en el rango D3, D5, D7 y D9.

Cada vez que informes un valor en una celda, se borran los otros tres.

He añadido una validación de los valores que pueden entrarse, revisa a  fondo el archivo adjunto.

Estas son las macros:

Private Sub Worksheet_Change(ByVal Target As Range)
Select Case Target.Address(False, False)
   Case "D3": Validar Target, 10
   Case "D5": Validar Target, 2
   Case "D7": Validar Target, 8
   Case "D9": Validar Target, 16
End Select
End Sub

Private Sub Validar(Target, Dígitos)
lista = "0123456789ABCDEF"
valor = CStr(Target)
If Len(valor) > 0 Then
   For x = 1 To Len(valor)
      ok = False
      For y = 1 To Dígitos
         If Mid(valor, x, 1) = Mid(lista, y, 1) Then ok = True
      Next
      If ok = False Then
         MsgBox "Solo se admiten valores: " & Left(lista, Dígitos), vbCritical
         Target = ""
         Target.Select
         Exit Sub
      End If
   Next
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Select Case Target.Address(False, False)
   Case "D3": If [D5] <> "" Or [D7] <> "" Or [D9] <> "" Then Borrar
   Case "D5": If [D3] <> "" Or [D7] <> "" Or [D9] <> "" Then Borrar
   Case "D7": If [D3] <> "" Or [D5] <> "" Or [D9] <> "" Then Borrar
   Case "D9": If [D3] <> "" Or [D5] <> "" Or [D7] <> "" Then Borrar
End Select
End Sub

Private Sub Borrar()
If [D3] <> "" Then [D3] = ""
If [D5] <> "" Then [D5] = ""
If [D7] <> "" Then [D7] = ""
If [D9] <> "" Then [D9] = ""
End Sub

 

ISC 1.xlsm

[Antoni]

La macro de evento Worksheet_SelectionChange puede sustituirse por esta un poco mas "pro": ?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("D3,D5,D7,D9")) Is Nothing Then Borrar
End Sub