Microsoft Excel:

  Таблицы и VBA. Справочник.
  Вопросы и Ответы. Советы. Примеры.
Меню FAQ | Макросы | Автофильтр & Расширенный фильтр


Rambler's Top100


Counter CO.KZ

  1. Как определить установлен или нет автофильтр ? 09.07.2006
  2. Как определить применён/активирован или нет фильтр (автофильтр/расширенный фильтр) ? 09.07.2006
  3. Как определить диапазон к которому применён автофильтр ? 30.08.2006
  4. Как определить общее количество строк в автофильтре ? 30.08.2006
  5. Как определить количество строк, полученных в результате применения автофильтра ? 30.08.2006
  6. Как перебрать все строки в автофильтре ? 30.08.2006
  7. Как перебрать только отфильтрованные строки в автофильтре ? 30.08.2006
  8. Как защитить лист, но сохранить возможность работы с автофильтром ? 28.03.2006
  9. Как используя расширенный фильтр, получить список уникальных, т.е. неповторяющихся значений нужного диапазона ? 23.04.2014
  10. Как использовать дату при применении автофильтра ? Лидер голосования 15.02.2005
  11. Как отфильтровать столбец, если критерий отбора это даты, которые находятся в ячейках рабочего листа ? 16.03.2011
  12. Как автоматически подсвечивать заголовки столбцов, в которых применён/активирован автофильтр ? 20.04.2007
  13. Как автоматически выводить критерии фильтрации (в ячейках рабочего листа) ? 22.04.2007
  14. Как вводить критерии отбора в ячейки определённой строки, а фильтровать столбец после установки "флажка" в этом столбце ? 16.03.2011
  15. Как скрыть выпадающие списки в автофильтре ? 16.03.2011
  16. Как убрать автофильтр в рабочем листе и "умных" таблицах (списках) ? 07.01.2016
  17. Как сохранить критерии фильтрации и, при необходимости, восстанавливать их ? 13.03.2016
  18. Как с помощью автофильтра получить даты за нужный месяц, причём вне зависимости от года ? NEW 08.05.2016
  19. Как в автофильтре использовать более двух критериев фильтрации ? 04.01.2016
  20. Как при использовании более двух критериев фильтрации, искать частичные совпадения ? 27.02.2016

  • Ответ :

    Вариант I.
  • If Worksheets(1).AutoFilterMode = True Then
       MsgBox "Автофильтр установлен"
    Else
       MsgBox "Автофильтр не установлен"
    End If
    Вариант II.
    If Not Worksheets(1).AutoFilter Is Nothing Then
       MsgBox "Автофильтр установлен"
    Else
       MsgBox "Автофильтр не установлен"
    End If
    Особенности Microsoft Excel 2003
    В этой версии появился новый об'ект ListObject, который переводчики назвали "список", а в России за ним закрепился (правда после выхода 2007) другой термин "умная таблица". И у этого списка тоже есть свой автофильтр, кнопки которого появляются на экране, после выделения любой из ячеек этой таблицы. Поэтому теперь, наличие/отсутствие автофильтра желательно проверять не только в рабочем листе, но и в таких списках.
    Dim iListObject As ListObject
    For Each iListObject In Worksheets(1).ListObjects
        If iListObject.ShowAutoFilter = True Then
           MsgBox "Автофильтр установлен"
        Else
           MsgBox "Автофильтр не установлен"
        End If
    Next

  • Ответ :
  • If Worksheets(1).FilterMode = True Then
       MsgBox "В рабочем листе применён фильтр"
    Else
       MsgBox "В рабочем листе не применён фильтр"
    End If
    Если необходимо проверить применение конкретного фильтра, то :
    If Worksheets(1).FilterMode = True Then
       MsgBox "В рабочем листе применён " & _
       IIf(Worksheets(1).AutoFilterMode = True, _
       "Автофильтр", "Расширенный фильтр")
    Else
       MsgBox "В рабочем листе не применён фильтр"
    End If
    Особенности Microsoft Excel 2007

    Если необходимо узнать, применён ли фильтр в каждой "умной таблице", то можно просто перебрать их в цикле и использовать свойство FilterMode.
    Dim iListObject As ListObject
    For Each iListObject In Worksheets(1).ListObjects
        If iListObject.ShowAutoFilter = True Then
           If iListObject.AutoFilter.FilterMode = True Then
              MsgBox "Таблица отфильтрована"
           Else
              MsgBox "В таблице не применён фильтр"
           End If
        End If
    Next

  • Ответ :
  • If Worksheets(1).AutoFilterMode = True Then
       Set iFilterRange = Worksheets(1).AutoFilter.Range
       MsgBox "Адрес диапазона с автофильтром " & iFilterRange.Address
    End If

  • Ответ :
  • If Worksheets(1).AutoFilterMode = True Then
       iAllCountOfRows = Worksheets(1).AutoFilter.Range.Rows.Count
       MsgBox "Общее количество строк в автофильтре " & iAllCountOfRows
    End If
    Примечание : Строки, которые являются частью заголовка таблицы, иначе называемой шапкой, также участвуют в подсчёте.
  • Ответ :
  • If Worksheets(1).AutoFilterMode = True Then
       If Worksheets(1).FilterMode = True Then
          iCountOfRows = Worksheets(1).AutoFilter.Range.Columns(1).SpecialCells(xlVisible).Count
          MsgBox "Количество отфильтрованных строк " & iCountOfRows - 1
       End If
    End If
    With ThisWorkbook.Worksheets(1) 'Workbooks(...)
         If .AutoFilterMode = True And .FilterMode = True Then
            With .AutoFilter.Range
                 iCountOfRows = .Columns(1).SpecialCells(xlVisible).Cells.Count
                 'iCountOfRows = .Columns(1).Rows.SpecialCells(xlVisible).Count
                 MsgBox "Количество отфильтрованных строк " & iCountOfRows - 1
            End With
         End If
    End With
    Примечание : Строки, которые являются частью заголовка таблицы, иначе называемой шапкой, не участвуют в подсчёте.
  • Ответ :
  • With ThisWorkbook.Worksheets(1)
         If .AutoFilterMode = True Then
            For Each iCell In .AutoFilter.Range.Columns(1).Cells '.Rows
                MsgBox iCell.Value
            Next
         End If
    End With
    Комментарий : Данный способ позволяет перебрать в цикле все ячейки первого столбца в котором установлен фильтр, поэтому ячейки, которые являются частью заголовка таблицы, также участвуют в цикле. Однако, как правило, необходимо перебрать только те ячейки, которые были получены вследствии применения автофильтра и без учёта заголовка таблицы. Именно такой способ опубликован в следующем совете.
  • Ответ :
  • With ThisWorkbook.Worksheets(1)
         If .AutoFilterMode = True And .FilterMode = True Then
            With .AutoFilter.Range.Columns(1)
                 Set iFilterRange = _
                 .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlVisible)
                 For Each iCell In iFilterRange
                     MsgBox iCell.Value
                 Next
            End With
            .ShowAllData 'Отобразить всё - необязательно
         End If
    End With
    Примечание : Обратите внимание на свойство Columns, используя его Вы сможете осуществить цикл в нужном столбце диапазона в котором установлен и активирован автофильтр.
  • Ответ : Скачать пример

    Для того, чтобы получить перечень уникальных, т.е. неповторяющихся значений столбца(или нескольких столбцов) можно использовать расширенный фильтр. Если это разовая акция или использование макросов нежелательно, то здесь [FAQ] можно найти подробное описание процесса, без применения VBA.

    Если же нужно проделать всё тоже самое, но программно, то достаточно просто записать свои действия макрорекордером [FAQ1], проанализировать полученный код, избавиться от мусора, например, от ненужного выделения листа и диапазона и получить готовый макрос.

    А если макрорекордеру Вы предпочитаете чтение данного сайта, то так можно отфильтровать данные столбца [A:A] активного рабочего листа и получить список уникальных данных.
  • Range("A:A").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    Обратите внимание на то, что в этом примере, повторы никуда не исчезают, они именно скрываются. Если это неприемлемо, то результат фильтрации можно скопировать в другие ячейки. При этом можно указывать ячейки другого рабочего листа, в т.ч. и нового.
    Range("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Worksheets.Add.Range("A1"), Unique:=True
    Worksheets("Лист1").Range("A1:С1000").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Worksheets("Лист2").Range("A1"), Unique:=True
    Важно :
  • Расширенный фильтр всегда воспринимает первую ячейку указанного диапазона как заголовок таблицы(шапку) и если таблица не имеет шапки, а значение первой ячейки будет повторяться и далее, то после фильтрации Вы получите один повтор. Этой неприятности можно избежать, если проверять наличие заголовка(шапки) [FAQ618] и в случае её отсутствия (перед фильтрацией) просто создавать её (возможно даже программно)
  • При выборе фильтрации на месте, необходимо учитывать, что в этом случае расширенный фильтр будет обрабатывать не значения ячеек, а формулы. Проще говоря, если в столбце будут константы, Вы можете не обращать внимание на это предупреждение, но если в столбце будут формулы, то в результате фильтрации Вы можете получить повторы, т.к. для расширенного фильтра две следующие формулы(ссылки) =B2 и =B3 уникальны, хотя они могут возвращать одно и тоже значение. Бороться с этим можно, если копировать результат в другое место (допускается копирование в ячейки скрытого листа)
  • Ответ : Вопрос выбран посетителями

    Вариант I.
  • Dim iDateOne As Date
    Dim iDateTwo As Date

    iDateOne = "08.09.2004"
    iDateTwo = "08.10.2004"

    iCriteria1 = ">=" & Format(iDateOne, "#")
    iCriteria2 = "<=" & Format(iDateTwo, "#")

    Range("A1").AutoFilter Field:=1, Criteria1:=iCriteria1, Operator:=xlAnd, Criteria2:=iCriteria2
    Совет : Вместо Format(iDate, "#") можно использовать Format(iDate, "General Number")

    Вариант II.
    iDateOne = #9/8/2004# ' "08.09.04"
    iDateTwo = #10/8/2004# ' "08.10.04"

    iCriteria1 = ">=" & CDbl(iDateOne)
    iCriteria2 = "<=" & CDbl(iDateTwo)

    Range("A1").AutoFilter Field:=1, Criteria1:=iCriteria1, Operator:=xlAnd, Criteria2:=iCriteria2
    Вариант III.
    iDateOne = #9/8/2004# ' "08.09.04"
    iDateTwo = #10/8/2004# ' "08.10.04"

    With Application
         iCriteria1 = ">=" & .Text(iDateOne, "@")
         iCriteria2 = "<=" & .Text(iDateTwo, "@")
    End With

    Range("A1").AutoFilter Field:=1, Criteria1:=iCriteria1, Operator:=xlAnd, Criteria2:=iCriteria2
    Внимание : Критерии взяты только в качестве примера !
  • Ответ : Скачать пример Актуально для MS Excel 97, 2000, XP

    Для того, чтобы отфильтровать столбец (содержащий даты), достаточно воспользоваться предыдущим советом [FAQ35], но если даты, которые служат критерием отбора, находятся в ячейках, то можно поступить и проще :
  • iCriteria1 = ">=" & Range("B1").Value2
    iCriteria2 = "<=" & Range("C1").Value2

    Range("A:A").AutoFilter Field:=1, Criteria1:=iCriteria1, Operator:=xlAnd, Criteria2:=iCriteria2
    Columns(1).AutoFilter Field:=1, Operator:=xlAnd, Criteria1:=">=" & Cells(1, 2).Value2, Criteria2:="<=" & Cells(1, 3).Value2
    [A1:A1000].AutoFilter 1, ">=" & [B1].Value2, xlAnd, "<=" & [C1].Value2
    Предполагается, что в результате фильтрации нам необходимо получить список, содержащий даты, которые больше или равны дате из ячейки "B1" и меньше или равны, чем дата в ячейке "C1"
  • Ответ : Скачать пример
    Для того, чтобы автоматически, т.е. сразу после применения автофильтра, изменить цвет заливки в заголовках отфильтрованного столбца, проделайте следующее :

    1. Откройте нужную рабочую книгу
    2. Перейдите в редактор VBA (ALT + F11) и скопируйте любую из представленных авторских функций в любой стандартный модуль. В случае отсутствия модуля, его нужно создать. Затем выйдите из редактора (ALT + Q)
    3. Выделите все ячейки, которые являются частью заголовка таблицы, иначе называемой шапкой.
    4. В меню Формат выберите команду Условное форматирование. В стандартном диалоговом окне : в поле со списком выберите Формула и введите либо =IsFilter() (если Вы выбрали первый вариант) либо =IsFilter(B2) (если Вы выбрали второй вариант, где B2 ссылка на самую первую ячейку выделенного диапазона) После чего, кликните кнопку Формат, установите нужные параметры форматирования (при этом, Вы можете изменить не только цвет заливки, но и, например, цвет шрифта, а также его начертание), а затем кликните кнопку OK.
    5. Сохраните все внесённые изменения (CTRL + S)
  • Private Function IsFilter() As Boolean
    '***************************************************'
    '   Автор Климов Павел Юрьевич                      '
    '   http://www.msoffice.nm.ru                       '
    '***************************************************'
         Dim iCell As Range
         Set iCell = Application.Caller
         With iCell.Worksheet
              If .AutoFilterMode = True Then
                 With .AutoFilter
                      For iColumn% = 1 To .Filters.Count
                          If Not Intersect(iCell, .Range. _
                             Columns(iColumn%)) Is Nothing Then
                             IsFilter = .Filters(iColumn%).On '
                             Exit Function
                          End If
                      Next
                 End With
              End If
         End With
    End Function
    Private Function IsFilter(iCell As Range) As Boolean
    '***************************************************'
    '   Автор Климов Павел Юрьевич                      '
    '   http://www.msoffice.nm.ru                       '
    '***************************************************'
         With iCell.Parent
              If .AutoFilterMode = True Then
                 Dim iCellFilter As Range
                 For Each iCellFilter In .AutoFilter.Range.Rows(1).Cells
                     iColumn% = iColumn% + 1
                     If iCellFilter.Address = iCell.Address Then
                        IsFilter = .AutoFilter.Filters(iColumn%).On
                        Exit Function
                     End If
                 Next
             End If
         End With
    End Function

  • Ответ : Скачать пример
    Для того, чтобы автоматически, т.е. сразу после применения автофильтра, вывести в нужных ячейках критерии фильтрации, проделайте следующее :

    1. Откройте нужную рабочую книгу
    2. Перейдите в редактор VBA (ALT + F11) и скопируйте нижеприведённую авторскую функцию в любой стандартный модуль. В случае отсутствия модуля, его нужно создать. После чего, выйдите из редактора (ALT + Q)
    3. Выделите ячейки, в которых, по Вашему мнению, должны отображаться критерии отбора(фильтрации) Причём, эти ячейки должны быть расположены в одной строке, строго над (или под, что менее удобно) необходимой таблицей.
    4. Затем введите =GetCriteria() и нажмите клавиши CTRL + ENTER
    5. Сохраните все внесённые изменения (CTRL + S)
  • Private Function GetCriteria$()
    '***************************************************'
    '   Автор Климов Павел Юрьевич                      '
    '   http://www.msoffice.nm.ru                       '
    '***************************************************'
         Application.Volatile True
         Dim iCell As Range, iFilterColumn As Range
         Set iCell = Application.Caller
         With iCell.Worksheet
              If Not .AutoFilterMode Or Not .FilterMode Then
                 'Здесь можно вывести отчёт о состоянии автофильтра
                 Exit Function
              End If
              For Each iFilterColumn In .AutoFilter.Range.Columns
                  iColumn% = iColumn% + 1
                  If Not Intersect(iFilterColumn, _
                     iCell.EntireColumn) Is Nothing Then
                     With .AutoFilter.Filters(iColumn%) '
                          If Not .On Then Exit Function '
                          GetCriteria$ = .Criteria1
                          If .Operator = xlAnd Then
                             GetCriteria$ = GetCriteria$ & " И " & .Criteria2
                          ElseIf .Operator = xlOr Then
                             GetCriteria$ = GetCriteria$ & " ИЛИ " & .Criteria2
                          End If
                          Exit Function
                     End With
                  End If
              Next
         End With
    End Function

  • Ответ : Скачать пример
    Если необходимо, чтобы критерии отбора вводились в ячейки соответствующего столбца, а сама фильтрация осуществлялась сразу после установки "флажка" , который находится в заголовке(шапке) этого столбца, то :

    1. Откройте нужную рабочую книгу
    2. Выделите рабочий лист, в котором необходимо фильтровать список.
    3. Выберите пустую строку, которая в дальнейшем будет служить местом хранения критериев, в данном примере, это самая первая строка. Обратите внимание на то, что ячейки должны быть расположены строго над (или под, что менее удобно) необходимой таблицей. Проще говоря, в ячейке A1 находится условие фильтрации столбца [A:A], в ячейке B1 условие отбора для столбца [B:B] и т.д.
    4. Затем, создайте для каждого столбца свой Флажок, для этого воспользуйтесь родным элементом управления с панели "Формы" и расположите их в заголовке столбца.
    5. Проследите, чтобы каждому "флажку" был назначен макрос CheckBox_Filter()
    Совет : Можно создать один единственный элемент управления, назначить ему макрос, а затем просто копировать его.
    6. Перейдите в модуль нужного листа, для этого подведите курсор мышки к ярлычку выделенного листа, нажмите на правую кнопку мышки, и в появившемся контекстном меню выберите пункт Исходный текст.
    7. Скопируйте нижеприведённый макрос в модуль листа. После чего, выйдите из редактора (ALT + Q)
    8. Присвойте диапазону, который Вы планируете фильтровать, имя База_данных [FAQ] [FAQ22] (этот пункт можно пропустить и в макросе вместо "DataBase" просто указать адрес диапазона, например, "A3:E100")
    9. Сохраните все внесённые изменения (CTRL + S)
  • Private Sub CheckBox_Filter()
        If Not Me.ProtectContents Then
           With Me.CheckBoxes(Application.Caller)
                With .TopLeftCell
                     iField& = .Column
                     iCriteria$ = .EntireColumn.Cells(1).Text
                End With
                If .Value = xlOff Then
                   Me.Range("DataBase").AutoFilter Field:=iField&
                Else
                   Me.Range("DataBase").AutoFilter _
                   Field:=iField&, Criteria1:=iCriteria$
                End If
            End With
        Else
           MsgBox "Рабочий лист защищён", vbExclamation, ""
        End If
    End Sub
    Комментарий :
  • Если необходимо отфильтровать данные на защищённом рабочем листе, то можно воспользоваться следующим советом [FAQ86]
  • Если ячейка, которая предназначена для хранения критериев отбора, пуста, то можно не фильтровать этот столбец, т.е. при установке "флажка" просто отказаться от действий, не имеющих особого смысла (за исключением случаев, когда в результате фильтрации необходимо получить именно пустые ячейки)
  • Если отфильтрованный столбец необходимо как-то "выделить", то пример с изменением цвета заливки ячейки с критерием, можно найти в этом примере.
  • Ответ : Скачать пример

    Если Вы планируете фильтровать таблицу только программно и не хотите, чтобы критерии отбора были случайно (или умышленно) изменены с помощью выпадающего списка, то эти кнопки со стрелочками можно просто скрыть, т.е. воспользоваться одним из двух нижеприведённых вариантов, естественно, учитывая особенности каждого.

    Вариант I.
  • Private Sub HiddenAllDropDowns()
        Dim iShape As Shape
        For Each iShape In Worksheets(1).Shapes
            If iShape.Type = msoFormControl Then
               If iShape.FormControlType = _
               xlDropDown Then iShape.Visible = msoFalse
            End If
        Next
    End Sub
    Комментарий :
  • Не рекомендуется применение данного макроса, когда в рабочем листе, кроме фильтра, присутствуют также элементы управления Поле со списком с панели инструментов "Формы", и сводные таблицы содержащие выпадающие списки, т.к. он скроет все вышеперечисленное.
  • Если в листе вообще нет других графических об'ектов, даже примечаний (комментариев), то все имеющиеся проверки можно убрать.
  • Этот макрос можно использовать даже в тех случаях, когда указанный рабочий лист защищён, в т.ч. и в отношении об'ектов.

    Вариант II.
  • Private Sub AutoFilterHiddenDropDowns()
        Dim iAutoFilter As AutoFilter, iFilter As Filter, iDiapazon As Range
        
        If Лист1.AutoFilterMode = True Then
           Set iAutoFilter = Лист1.AutoFilter
           Set iDiapazon = iAutoFilter.Range
           For Each iFilter In iAutoFilter.Filters
               iColumn% = iColumn% + 1
               With iFilter
                    If .On = True Then
                       If .Operator = xlAnd Or .Operator = xlOr Then
                          iDiapazon.AutoFilter _
                          iColumn%, .Criteria1, .Operator, .Criteria2, False
                       Else
                          iDiapazon.AutoFilter iColumn%, .Criteria1, , , False
                       End If
                    Else
                       iDiapazon.AutoFilter iColumn%, , , , False
                    End If
               End With
           Next
        End If
    End Sub
    Private Sub AutoFilterHiddenDropDowns2()
        Dim iDiapazon As Range, iFilters As Filters
        Dim iAutoFilter As AutoFilter, iColumn%
        Set iAutoFilter = Лист1.AutoFilter
        
        If Not iAutoFilter Is Nothing Then
           Set iFilters = iAutoFilter.Filters
           Set iDiapazon = iAutoFilter.Range
           For iColumn = 1 To iFilters.Count
               With iFilters(iColumn)
                    If .On = True Then
                       If .Operator = xlAnd Or .Operator = xlOr Then
                          iDiapazon.AutoFilter Field:=iColumn, _
                          Criteria1:=.Criteria1, Operator:=.Operator, _
                          Criteria2:=.Criteria2, VisibleDropDown:=False
                       Else
                          iDiapazon.AutoFilter Field:=iColumn, _
                          Criteria1:=.Criteria1, VisibleDropDown:=False
                       End If
                    Else
                       iDiapazon.AutoFilter Field:=iColumn, VisibleDropDown:=False
                    End If
               End With
           Next
        End If
    End Sub
    Комментарий :
  • Если рабочий лист защищён, то Вы получите ошибку, которую можно избежать, если воспользоваться следующим советом [FAQ86]
  • Если фильтр уже применён/активирован, причём об'ём отфильтрованных данных довольно велик, то на время повторной фильтрации, имеет смысл заблокировать обновление экрана [FAQ43]
  • Ответ : Актуально для MS Excel 2003 (и старше)

    Если необходимо избавиться от автофильтра (т.е. отобразить все строки и убрать выпадающие списки (кнопки со стрелками)) из рабочего листа и "умных" таблиц (списков), то можно использовать следующий вариант, где необходимо просто указать свой рабочий лист.
  • Private Sub ShowAutoFilterFalse()
        Лист1.AutoFilterMode = False
        Dim iListObject As ListObject
        For Each iListObject In Лист1.ListObjects
            iListObject.ShowAutoFilter = False
        Next
    End Sub
    Private Sub ShowAutoFilterFalse2()
        With Worksheets(1) 'Worksheets("Отчёт")
             .AutoFilterMode = False
             Dim iListObject As ListObject
             For Each iListObject In .ListObjects
                 iListObject.ShowAutoFilter = False
             Next
        End With
    End Sub

  • Ответ : Актуально для MS Excel 95-2003

    Если возникнет необходимость в сохранении критериев фильтрации автофильтра и их программном восстановлении (только в течении работы с книгой), то для сохранения, можно использовать макрос AutoFilterSave, а для того, чтобы вернуть всё на круги своя AutoFilterApply или AutoFilterApply2
  • Private iList As Worksheet
    Private iAddress$, iColumn%, iArr() As Variant
    
    Private Sub AutoFilterSave()
        Set iList = ActiveSheet 'Можно указать вполне конкретный лист
        If iList.AutoFilter Is Nothing Then
           MsgBox "Aвтофильтр отсутствует", vbCritical, iList.Name
           Exit Sub
        End If
        
        With iList.AutoFilter.Filters
             ReDim iArr(1 To .Count, 1 To 3)
             For iColumn = 1 To .Count
                 With .Item(iColumn)
                      If .On = True Then
                         iArr(iColumn, 1) = .Criteria1
                         If .Operator = xlOr Then
                            iArr(iColumn, 2) = .Operator
                            iArr(iColumn, 3) = .Criteria2
                         End If
                      End If
                 End With
             Next
             iAddress = .Parent.Range.Address
        End With
    End Sub
        
    Private Sub AutoFilterApply()
        If iAddress = "" Then
           MsgBox "Восстановление невозможно ...", vbCritical, ""
           Exit Sub
        End If
    
        Dim iSource As Range: Set iSource = iList.Range(iAddress)
    
        For iColumn = 1 To UBound(iArr)
            If Not IsEmpty(iArr(iColumn, 1)) Then
               If iArr(iColumn, 2) = xlOr Then
                  iSource.AutoFilter iColumn, _
                  iArr(iColumn, 1), iArr(iColumn, 2), iArr(iColumn, 3)
               Else
                  iSource.AutoFilter iColumn, iArr(iColumn, 1)
               End If
            Else
               iSource.AutoFilter iColumn
            End If
        Next
    End Sub
    
    Private Sub AutoFilterApply2()
        If iAddress = "" Then
           MsgBox "Восстановление невозможно ...", vbCritical, ""
           Exit Sub
        End If
       
        If iList.FilterMode = True Then iList.ShowAllData 'iList.FilterMode = False
    
        With iList.Range(iAddress)
             For iColumn = 1 To UBound(iArr)
                 If Not IsEmpty(iArr(iColumn, 1)) Then
                    If iArr(iColumn, 2) = xlOr Then
                       .AutoFilter iColumn, _
                       iArr(iColumn, 1), iArr(iColumn, 2), iArr(iColumn, 3)
                    Else
                       .AutoFilter iColumn, iArr(iColumn, 1)
                    End If
                 End If
             Next
        End With
    End Sub

  • Ответ : Актуально для MS Excel 2007 (и старше)

    Если возникнет необходимость, с помощью автофильтра, получить все даты определённого месяца, но без учёта года, то начиная с XL2007 это можно осуществить так :
  • Private Sub AutoFilter_ChangeMonth()
        Dim iMonth%: iMonth = 2 'Укажите свой месяц
        
        Range("A:A").AutoFilter Field:=1, Criteria1:=iMonth + 20, Operator:=xlFilterDynamic
    End Sub
    Совет : Если Вы являетесь обладателем MS Excel 2003 (или младше), то решить поставленную задачу сможете, либо с помощью автофильтра + доп. столбец с формулами, которые будут возвращать месяц, либо с помощью расширенного фильтра, только в этом случае, Вам также придётся использовать дополнительные ячейки (2-е шт.)
  • Ответ : Актуально для MS Excel 2007 (и старше)

    На самом деле, даже в 2007 критериев всего два, но в этой версии критерием отбора может быть массив. Поэтому, если мы захотим, с помощью автофильтра, получить ячейки, содержащие, допустим, следующие фамилии "Иванов", "Петров", "Сидоров", то это можно будет осуществить, так :
  • Range("A:A").AutoFilter Field:=1, Criteria1:=Array("Иванов", "Петров", "Сидоров"), Operator:=xlFilterValues
    [A:A].AutoFilter 1, Array("Иванов", "Петров", "Сидоров"), xlFilterValues
    Если критерии должны располагаться в ячейках рабочего листа, то имейте ввиду, что диапазон-источник должен содержать одну строку(или * столбец). Если же Вы нарушите это правило, то результат будет отличаться от желаемого, т.к. при указании диапазона A1:B3 только значения ячеек A1 и B1 будут использованы в качестве критерия отбора. * По этой же причине, данные, которые находятся в столбце, например, A1:A3, необходимо ещё и транспонировать (см. нижеопубликованный код)
    Лист1.Range("A:A").AutoFilter Field:=1, _
    Criteria1:=Лист2.Range("A1:C1").Value, Operator:=xlFilterValues
    Лист1.Range("A:A").AutoFilter Field:=1, Criteria1:= _
    Application.Transpose(Лист2.Range("A1:A3")), Operator:=xlFilterValues
    Совет : Если Вы являетесь обладателем MS Excel 2003 (или младше), то решить поставленную задачу сможете с помощью расширенного фильтра, только для этого обязательно придётся использовать дополнительные ячейки.
  • Ответ : Актуально для MS Excel 2007 (и старше)

    Не секрет, что если критерием отбора является массив, то использовать символы подстановки ? * и получить желаемый результат, не получится. Однако, это ограничение можно "обойти", если сначала найти все частичные совпадения, например, с помощью стандартного поиска, а затем, просто использовать найденные значения.
  • Private Sub AutoFilter_LikeText()
        Dim iAddress$, iText$, iCriteria1(), iCriteria2()
        Dim iSource As Range, iCell As Range, iCount1&, iCount2&
        
        Set iSource = Range("A:A") '[A:A]
        iCriteria1 = Array("Иванов", "Петров", "Сидоров")
        
        For iCount1 = 0 To UBound(iCriteria1)
            iText = iCriteria1(iCount1)
            Set iCell = iSource.Find(iText, , xlValues, xlPart)
            'Set iCell = iSource.Find("*" & iText & "*", , xlValues, xlWhole)
            If Not iCell Is Nothing Then
               iAddress = iCell.Address
               Do
                    ReDim Preserve iCriteria2(iCount2)
                    iCriteria2(iCount2) = iCell.Value
                    iCount2 = iCount2 + 1
                    Set iCell = iSource.FindNext(iCell)
               Loop While iAddress <> iCell.Address
            End If
        Next
        
        If iCount2 > 0 Then
           iSource.AutoFilter 1, iCriteria2, xlFilterValues
        Else
           MsgBox Join(iCriteria1, vbCrLf), , "Ничего не найдено"
        End If
    End Sub
    Важно : Обратите внимание на то, что при поиске можно использовать символы подстановки ? * , что даёт нам возможность задать разные условия отбора(фильтрации)

    Например, получить все ячейки, где текст :
    1) начинается с "Иванов" (Иванов, Иванова)
    2) заканчивается на "ин" (Лукин, Букин)
    3) только второй символ может быть любым (Рязанов, Рузанов)
    iCriteria1 = Array("Иванов*", "*ин", "Р?занов")
    
    Set iCell = iSource.Find(iText, , xlValues, xlWhole)
    Совет : Если Вы являетесь обладателем MS Excel 2003 (или младше), то решить поставленную задачу сможете с помощью расширенного фильтра, только для этого обязательно придётся использовать дополнительные ячейки.


    Вопросы - Синонимы
  • Как определить количество отфильтрованных строк в автофильтре ?
  • Как в цикле перебрать строки полученные в результате применения автофильтра ?


  • Воспроизведение любых опубликованных здесь материалов возможно только с письменного разрешения автора : Microsoft Excel 95, 97, 2000, XP

    © 2004-2017 Климов П.Ю. Все права защищены. WebDesign & Error's Klimoff