В этой статье мы создадим макрос для отображения критериев, используемых в автоматическом фильтре.

Исходные данные состоят из сведений о клиенте, включая имя, номер телефона, идентификатор электронной почты и название компании.

ArrowRawData

Мы применили фильтр в столбце «Компания» и теперь хотим определить название компании, к которой применяется фильтр.

ArrowFilterData

Мы нажмем кнопку «Разделение данных фильтра», чтобы получить критерии, по которым применяется фильтр.

ArrowOutput

Код Описание

IntRow = Range («A10»). CurrentRegion.Rows.Count + 12 Приведенный выше код используется для получения номера строки, в которой должен отображаться вывод.

ActiveSheet.AutoFilter.Filters (IntCol) .On Приведенный выше код используется для проверки того, применен ли фильтр к определенному столбцу.

Для каждого StringValue в .Criteria1 MainString = MainString + Mid (StringValue, 2) + «|»

Далее Приведенный выше код используется для создания строки, состоящей из всех значений критериев, используемых в фильтре.

Диапазон («A10»). CurrentRegion.SpecialCells (xlCellTypeVisible) .Copy _ Cells (IntRow + 1, 1)

Приведенный выше код используется для копирования видимых строк в указанное место назначения.

Пожалуйста, введите код ниже

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

Если вам понравился этот блог, поделитесь им с друзьями на Facebook и Facebook.

Мы будем рады услышать от вас, дайте нам знать, как мы можем улучшить нашу работу и сделать ее лучше для вас. Напишите нам на [email protected]