lunes, 22 de diciembre de 2014

VBA: Búsqueda doble sobre cualquier parte de una tabla de Excel.

En una entrada anterior hablamos sobre cómo conseguir localizar un valor buscado en cualquier parte de una tabla (ver). Lo que solucionamos con una matricial.
En el día de hoy veremos el código de una sencilla función personalizada (UDF) en VBA que nos realice la misma operación y resultado.
Mantenemos las condiciones iniciales en las que no debe haber duplicados, basada en el método .Find


Insertamos en un módulo estándar de nuestro proyecto de VBA el siguiente procedimiento Function:

Function FxBusquedaDoble(ValorBuscado As Variant, rng As Range, Campo As String)
Dim fila As Long, col As Long

Application.Volatile

'buscamos en el rango dado el ValorBuscado
With rng
    Set c = .Find(ValorBuscado, LookIn:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            'una vez localizado nos quedamos con su número de fila
            fila = c.Row
        Loop While Not c Is Nothing And c.Address <> firstAddress
    Else
        'en caso de no encontrar nada como Valores
        'buscamos como fórmulas (valores numéricos, etc...)
        Set c = .Find(ValorBuscado, LookIn:=xlFormulas)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                'una vez localizado nos quedamos con su número de fila
                fila = c.Row
            Loop While Not c Is Nothing And c.Address <> firstAddress
        Else
            'si no encontramos como valores o como fórmulas
            'devolvemos 0 y salimos de la función
            FxBusquedaDoble = 0
            Exit Function
        End If
    End If
End With

'localizamos sobre el encabezado del rango de datos seleccionado
'el número de columna que corresponde al Campo a retornar el valor
Set rng1 = rng.Offset(-1, 0).Resize(1, rng.Columns.Count)
'con la función MATCH/COINCIDIR tenemos el número de columna (de izqd a dcha)
'contando desde la columna A
col = Application.WorksheetFunction.Match(Campo, rng1, 1)

'devolvemos valor a la función
FxBusquedaDoble = Cells(fila, col).Value

End Function



El resultado es el esperado, equivalente a nuestra matricial:

VBA: Búsqueda doble sobre cualquier parte de una tabla de Excel.
haz clic en la imagen



Nuestra función UDF en la celda J7:
=FxBusquedaDoble(I6;A7:F10;H6)
donde indicamos que el 'ValorBuscado' está en I6
el rango donde buscar (sin cabecera) es A7:F10
y el campo del que queremos retornar el valor está definido en H6.


En este ejemplo es importante que el rango donde buscar comience en la columna A, y que no se seleccione el encabezado en el mismo.

2 comentarios:

  1. Hola Ismael
    Primero gracias por el codigo Salir (application.Quit) y segundo soy nuevo en Vb por lo que la tarea que me asignaron
    como alumno en practica es nada que ver con lo que deberia aprender o desarrollar, asique estoy complicado y su ayuda
    seria genial.

    Parte de la programación de su ejemplo me ayudaria ya que con un ComboBox (no editable, usando el de control de formulario)
    debo realizar las siguiente instrucciones

    1° En un ComboBox (que esta en Hoja1 ) mostrar la información de toda una columna (que esta en Hoja2)
    2° Al elegir una de las opciones del combobox se imprima en varios textbox (una celda para cada uno) la informacion de las celdas que le corresponden a la eleccion, por ejemplo

    Pais Capital PIB Crecimiento
    Chile (seleccion) Santiago 123456789 2%


    Textbox1 Textbox2 Textbox3
    Santiago 123456789 2%

    3° Apretar un boton y se copia al portapapeles la información que se expresa en el textbox, es decir presionar el boton en vez de hacer ctrl + C
    4° Si elijo otra opcion sale la informacion correspondiente a esa otra opcion
    5° Al apretar el boton salir, no solo se cierra el excel, sino tambien se limpian todos los campos

    Saludos.

    ResponderEliminar
    Respuestas
    1. Hola jerzy,
      para lo que me planteas, mejor lee primero las Normas de uso del blog, y si te interesa envíame detalle a:
      excelforo@gmail.com
      Saludos cordiales

      Eliminar