En este artículo, crearemos una macro para mostrar los criterios utilizados en el filtro automático.

Los datos brutos consisten en detalles del cliente, que incluyen nombre, número de teléfono, identificación de correo electrónico y nombre de la empresa.

ArrowRawData

Hemos aplicado un filtro en la columna Compañía y ahora queremos determinar el nombre de la empresa a la que se aplica el filtro.

ArrowFilterData

Haremos clic en el botón «Separar datos de filtro» para obtener los criterios para los que se aplica el filtro.

ArrowOutput

Explicación del código

IntRow = Rango («A10»). CurrentRegion.Rows.Count + 12 El código anterior se usa para obtener un número de fila, donde se debe mostrar la salida.

ActiveSheet.AutoFilter.Filters (IntCol) .On El código anterior se usa para verificar si el filtro se aplica en la columna en particular.

Para cada StringValue en .Criteria1 MainString = MainString + Mid (StringValue, 2) + «|»

Siguiente El código anterior se utiliza para crear una cadena que consta de todos los valores de los criterios utilizados en el filtro.

Rango («A10»). CurrentRegion.SpecialCells (xlCellTypeVisible) .Copy _ Cells (IntRow + 1, 1)

El código anterior se utiliza para copiar filas visibles al destino especificado.

Siga a continuación el código

Option Explicit

Sub FilterCriteria()

'Declaring variables

Dim IntRow, IntCol As Integer

Dim MainString, StringValue As Variant

'Initializing the row and column number

IntRow = Range("A10").CurrentRegion.Rows.Count + 12

IntCol = 1

'Looping through all the cells until blank cell is encountered in the 10th row

Do Until IsEmpty(Cells(10, IntCol))



With ActiveSheet.AutoFilter.Filters(IntCol)

'Checking whether filter is applied on the column

If .On Then



MainString = "Filter On Column no. " & IntCol & " on values : "



'Creating text which consists of values used in the filter

For Each StringValue In .Criteria1

MainString = MainString + Mid(StringValue, 2) + "|"

Next



'Assigning value to cell

Cells(IntRow, 1).Value = MainString



Exit Do



End If



End With



IntCol = IntCol + 1

Loop

'Copying the visible cells to row after the filter data

Range("A10").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _

Cells(IntRow + 1, 1)

End Sub

Si te gustó este blog, compártelo con tus amigos en Facebook y Facebook.

Nos encantaría saber de usted, háganos saber cómo podemos mejorar nuestro trabajo y hacerlo mejor para usted. Escríbanos a [email protected]