VBA: Busca Find con retorno múltiple

Noviembre 2016



Un simple busca Find te muestra la primera coordenada encontrada.

En ciertas circunstancias es necesario conocer todas las coordenadas de los casos encontrados.

Es lo que hace esta pequeña función.


En modulo público


'Muestra todas las coordenadas (referencias de las celdas) encontradas en la búsqueda 
'WkbN = nombre del libro, con este dato, la función puede ser colocada en un xla 
'WksN = nombre de la hoja 
'Plage = las coordenadas del rango de celdas a buscar. 
'Retorno a la tabla dada como argumento. 
Function RechFind(ByVal Cle As String, ByVal WkbN As String, ByVal WksN As String, ByVal Plage As String, ByRef TBadress() As Variant) As Long 
Dim Busca, Ix As Long, ubica 
    With Workbooks(WkbN).Sheets(WksN).Range(Plage) 
        Set Busca = .Find(valor) 
        If Not Busca Is Nothing Then 
            ubica = Busca.Address 
            Do 
                ReDim Preserve TBadress(Ix) 
                TBadress(Ix) = Busca.Address 
                Set Busca = .FindNext(Busca) 
                Ix = Ix + 1 
            Loop While Not Busca Is Nothing And Busca.Address <> ubica 
        End If 
    End With 
    'número de casos encontrados, Retorno 0 si no hay ningún caso 
    RechFind = Ix 
    Set Busca = Nothing 'Libera la memoria ocupada por el objeto. 
End Function

El cuerpo de la función es separada eventualmente al ser colocada en libro Xla.

Ejemplo usando macros


Puede ser colocado en un módulo del libro:
Sub RechMulti() 
Dim R As Long, TB() 
Dim i As Integer 
    R = RechFind("12*", ThisWorkbook.Name, "Hoja1", "B1:B500", TB()) 
    If R > 0 Then 
        For i = 0 To R - 1 ' o ubound(TB) 
            'ejemplo 
            Sheets("Hoja1").Cells(i + 4, 5) = Range(TB(i)).Row 
        Next i 
    End If 
End Sub

Ejemplo usando un botón


Private Sub CommandButton1_Click() 
Dim R As Long, TB() 
Dim i As Integer 
    Range("E4:E20").ClearContents 
    R = RechFind(Range("E2"), ThisWorkbook.Name, ActiveSheet.Name, Range("B1:B500").Address, TB()) 
    If R > 0 Then 
        For i = 0 To R - 1 ' o ubound(TB) 
            'ejemplo 
            Sheets("Feuil1").Cells(i + 4, 5) = Range(TB(i)).Row 
        Next i 
    End If 
End Sub

Consulta también :
El documento « VBA: Busca Find con retorno múltiple» de CCM (es.ccm.net) se encuentra disponible bajo una licencia Creative Commons. Puedes copiarlo o modificarlo siempre y cuando respetes las condiciones de dicha licencia y des crédito a CCM.