VBA: Otro ejemplo de macro en Excel con INTERSECT.

Hace unos días expliqué una instrucción de VBA interesante, el método INTERSECT, y en este post, lo volveré a emplear para contestar la cuestión de un usuario:

...Necesitaría obtener la dirección de la la celda activa para utilizarla en un formato condicional de una celda diferente (en la cabecera) , de manera que al seleccionar una celda, se me activara o no el formato según el valor de la celda seleccionada. Ejemplo: A B C D 1 Titulo 1 Titulo 2 Titulo 3 2 fecha 1 1 0 0 3 fecha 2 1 1 0 4 fecha 3 1 0 0 5 fecha 4 0 1 1 6 fecha 5 1 1 1 En esta tabla debería configurar el formato condicional de las celdas B3, C3 y D3 de forma que, si selecciono cualquier celda de la fila 3, se deberían colorear las celdas B1 y C1 (porque las celdas B3 y C3 tienen el valor 1). Si selecciono cualquier celda de la fila 6, se deberían colorear la B1, C1 y D1, etc....

Veamos una imagen de nuestra tabla de trabajo:

La macro a construir debe evaluar varios condicionantes, en primer lugar que nuestro cursor (nuestra celda activa) se halla dentro del rango adecuado de la tabla, para nuestro ejemplo en el rango B2:D6; otra condición a cumplir será verificar que una vez dentro del rango definido las celdas de fila activa tiene un valor igual a 1; en cuyo caso, asignaremos un color a la cabecera de la tabla.
En caso contrario, ya sea que la celda activa queda fuera del rango B2:D6 o las celdas de la fila activa dentro del rango definido tengan un valor diferente a 1 la cabecera de la tabla debe quedarse sin modificaciones.
Nuestro código VBA a incluir en una Hoja del Explorador del proyecto dentro del Editor de VBA es:

Sub worksheet_selectionchange(ByVal target As Range)
Dim celdaactiva As Object
Dim numfila As Variant
'definimos el número de fila de la celda activa
numfila = ActiveCell.Row

'concretamos la observación dentro del rango B2:D6
For Each celdaactiva In Range("B2:D6")
If Intersect(ActiveCell, Range("B2:D6")) Is Nothing Then
'La celda activa NO cruza con las celdas del rango
Range("B1:D1").Interior.Pattern = xlNone
Else
'La celda activa SI cruza con las celdas del rango
For i = 1 To 3
'con For pasamos por todas las columnas de la tabla
''con If verificamos el valor de la celda
If Cells(numfila, i + 1).Value = 1 Then
Cells(1, i + 1).Interior.Color = 65535
Else
Cells(1, i + 1).Interior.Pattern = xlNone
End If
Next
End If
Next
End Sub

Verificando que, efectivamente, sólo cambia el color de la cabecera de la tabla, cuando la celda activa se encuentra en el rango B2:D6 y los valores de la 'fila activa' son iguales a 1.