miércoles, 19 de julio de 2017

VBA: Filtrar Números que contengan ciertos dígitos

Recientemente me planteaba un lector la posibilidad de aplicar, desde nuestra programación en VBA,
un autofiltro sobre valores numéricos, con la condición de filtro que contenga ciertos dígitos.

En definitiva se trata de replicar el comportamiento del cuadro de búsqueda incorporado en el Autofiltro. Como se puede fácilmente ver en la imagen siguiente:

VBA: Filtrar Números que contengan ciertos dígitos



El intento del lector fue emplear el comodín * (asterisco) para componer un filtro de contine...
Criteria1:="=*" & CStr(Range("B1").Value) & "*"
pero que NO FUNCIONA!!!.
Ya que al ejecutar lo grabado no cruza los datos como texto en ambos casos:

Sub Macro1()
ActiveSheet.Range("$B$3:$C$12").AutoFilter Field:=1, _
        Criteria1:="=*" & CStr(Range("B1").Value) & "*", _
        Operator:=xlAnd     'xlFilterValues
End Sub



La clave la obtenemos al grabar el proceso con el asistente de grabación de macros, donde obtenemos el siguiente código:

Sub Macro2()
'
' Macro2 Macro
'

'
    ActiveSheet.Range("$B$3:$C$12").AutoFilter _
        Field:=1, _
        Criteria1:=Array("12,13", "13", "133", "98813"), _
        Operator:=xlFilterValues
End Sub



Vemos como la macro grabada ha añadido como criterio una matriz de aquellos valores que contenían el 'número' buscado (13 en nuestro ejemplo).

Bien, pues esa será la clave, debemos generar nuestra propia Matriz-Array en nuestra programación, pero que sea dinámica en cuanto al dígito buscado... apoyándonos en el valor de la celda B1.


Abrimos la ventana de código de nuestro módulo estándar y añadimos el siguiente código:

Sub FiltrarNumeroComoTexto()
Dim arr() As String
Dim celda As Range

x = 0
'recorremos el rango de celdas del campo
'para contar cuántas coincidencias existen
For Each celda In Range("B4:B12")
    'evaluamos si el valor de la celda
    'contiene los dígitos buscados
    If InStr(1, celda.Value, Range("B1").Value, vbTextCompare) > 0 Then
        'aumentamos el contador
        x = x + 1
    End If
Next celda

'redimensionamos la Matriz que contendrá los valores del rango
'que contienen los dígitos buscados
ReDim arr(1 To x) As String
i = 0
'pasamos por todas las celdas...
For Each celda In Range("B4:B12")
    'si la celda contiene los dígitos
    If InStr(1, celda.Value, CStr(Range("B1").Value), vbTextCompare) > 0 Then
        'cargamos la matriz con el valor
        i = i + 1
        arr(i) = CStr(celda.Value)
    End If
Next celda

'Finalmenete aplicamos el autofiltro estándar, con los componentes de la matriz
ActiveSheet.Range("$B$3:$C$12").AutoFilter _
        Field:=1, _
        Criteria1:=(arr), _
        Operator:=xlFilterValues

End Sub



Al ejecutar comprobamos como el Autofiltro se aplica, como era de esperar, a los valores que contengan el dato de la celda B1.

El procedimiento anterior emplea, así lo requeríamos, el Autofiltro... pero otra forma algo más sencilla es emplear la acción de Ocultar o Mostrar filas (OJO!!, no tiene los mismos efectos que aplicar un autofiltro!!).
Esta sería otra posibilidad:

Sub VisualizarNumeroComoTexto()

Dim celda As Range
For Each celda In Range("B4:B12")
    If InStr(1, celda.Value, CStr(Range("B1").Value), vbTextCompare) > 0 Then
        celda.EntireRow.Hidden = False
    Else
        celda.EntireRow.Hidden = True
    End If
Next celda

End Sub

No hay comentarios:

Publicar un comentario