jueves, 3 de mayo de 2018

VBA: Imitando un vínculo entre hojas

Un lector hace unos días preguntaba por la manera de replicar un vínculo entre hojas.
[...]la idea es que al dar clic en el código de la hoja 1 se llegue al código de la hoja 2 para poder realizar cambios en el precio del articulo[...]


Supongamos tenemos dos hojas de trabajo:
Hoja 'datos' donde tenemos un listado de los productos y sus precios (donde queremos que nos lleve el 'vínculo')
Hola 'PPAL' donde usamos en cada registro los códigos necesitados

VBA: Imitando un vínculo entre hojas



El objetivo consiste en que al seleccionar las celdas del rango B2:B13 de la hoja 'PPAL' nos traslade a la hoja 'datos' y en concreto a la celda donde se encuentre el 'artículo' seleccionado.

Para ello usaremos un evento de programación de la hoja 'PPAL', donde combinando métodos de trabajo como .Find o Intersect, y a través de un bucle (Do...Loop) terminamos haciendo un .Select sobre la celda buscada en la hoja 'datos'.

En la ventana de código de la hoja principal incluimos el siguiente procedimiento:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'evitamos el fallo si se seleccionan varias celdas...
If Target.Count > 1 Then Exit Sub

'verificamos que sólo actue si nos encontramos en las columnas X ó Y
If Not Intersect(Target, Range("B2:B13")) Is Nothing Then
    'depuramos posibles errores, en caso que la celda está vacía salimos de la rutina
    If Target.Value = "" Then
        Exit Sub
    Else
        'buscamos la ubicación en la hoja datos
        With Worksheets("datos").Range("A:A")
            Set c = .Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
            If Not c Is Nothing Then
                firstAddress = c.Address
                Do
                    'en la coincidencia seleccionamos la hoja
                    Sheets("datos").Select
                    'y la celda encontrada
                    c.Select
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstAddress
            End If
        End With
    End If
End If

End Sub



Listo para probar...

No hay comentarios:

Publicar un comentario