Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Автофильтр на нескольких листах по аналогичным полям
 
#1
15.01.2016 16:19:02
Добрый день.

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

Прикрепляю пример файла, в котором необходимо реализовать данную задачу.

Заранее благодарю за помощь!
 
 
 
#2
15.01.2016 19:27:09
Цитата
при каждом переходе с листа на лист на каждом следующем листе в этих 3-х одинаковых полях должны повторяться условия фильтров
Т.е. должны повторяться условия фильтра с Лист1 ?
 
 
 
#3
18.01.2016 20:31:12
Да, но не только. Если фильтр установили на Листе 2, то в случае перехода на Лист 1 должен повториться фильтр с Листа 2, и то же самое должно произойти в случае перехода на Лист 3. Если фильтр установили на Листе 3, то при переходе на Лист 1 или Лист 2, должен повториться фильтр с Листа 3.

P.S. прошу прощение за задержку с ответом)
 
 
 
#4
18.01.2016 20:51:07
Посмотрите макрос, перенести в модуль эта книга. Я ориентировался на фильтр листа1. Попробуйте допилить код
для случаев, когда фильтры установлены на других листах.
Код
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim iAF As AutoFilter
Dim iFlt As Filter
Dim iField As String
Dim iCrit1 As String
Dim iCrit2 As String
Dim iOperator As String
Dim i As Integer
Dim iSht As Worksheet
Dim Sht_1 As Worksheet
   Set Sht_1 = ThisWorkbook.Worksheets("Лист1")
   Set iAF = Sht_1.AutoFilter
     'просматриваем шапку, ищем где установлен фильтр?
   For i = 1 To iAF.Filters.Count
     iField = iAF.Range.Cells(1, i).Value 'название в шапке
     Set iFlt = iAF.Filters(i)
     If iFlt.On Then
       iCrit1 = iFlt.Criteria1
         If iFlt.Operator = 0 Then
          iCrit2 = ""
         Else
          iCrit2 = iFlt.Criteria2
          iOperator = iFlt.Operator
         End If
       For Each iSht In Worksheets
         If iSht.Name <> "Лист1" Then        ' кроме листа
          With iSht
           If iFlt.Operator = 0 Then
             .UsedRange.AutoFilter Field:=i, Criteria1:=iCrit1
           Else
             .UsedRange.AutoFilter Field:=i, Criteria1:=iCrit1, Operator:=iOperator, Criteria2:=iCrit2
           End If
          End With
         End If
       Next
     Else
       For Each iSht In Worksheets
         If iSht.Name <> "Лист1" Then        ' кроме листа
           With iSht
             .UsedRange.AutoFilter Field:=i
           End With
         End If
       Next
     End If
   Next
End Sub
 
 
 
#5
18.01.2016 21:17:50
Сделал макрорекордером простую наборку. Двойным кликом по нужной ячейке, происходит фильтрация на трех листах. Какая разница при открытии листа сработает фильтр или при выборе на одном из листов. Если есть разница, значит я что то не понял. Правда с такой фильтрацией много вопросов. Если фильтр не установили а сняли, должны ли изменится фильтры на других листах? Сколько фильтров будет устанавливаться по одному столбцу или по нескольким? Если сняли фильтр на одном листе и потом установили по двум столбцам, что должно быть на других листах?
Изменено: gling - 18.01.2016 21:39:45
 
 
 
#6
18.01.2016 21:42:19
gling
Володя, если на листе (например Лист3) не установлен фильтр, то будет ошибка в строке
Код
Sheets("Лист3").ShowAllData
 
 
 
#7
18.01.2016 21:58:35
Да я заметил, поэтому исправил и файл перевложил молча. Думал что его еще никто не скачнул. Это так простой вариант для наглядности, что это можно сделать макрорекордером, в помощь автору, может вариант пригодится для простого действия.
Изменено: gling - 18.01.2016 22:00:08
 
 
 
#8
18.01.2016 22:23:54
gling
Володя, надо проверять включен ли фильтр
Код
If ActiveSheet.FilterMode=True Then
   ActiveSheet.ShowAllData
End If
 
 
 
#9
18.01.2016 22:36:02
Kuzmich, я даже и не задумывался над этим, обходил ошибку обработчиком. Пока не натыкался на "подводные камни", если бы наткнулся, то задумался. Понимаю, что с проверкой будет правильней. Спасибо за совет, буду пользоваться.
 
 
 
#10
29.01.2016 13:04:31
Всем спасибо за помощь.
Написала вот такой код (только у меня 5 листов и колонки с 3й по 6ю):
Код
Sub RecountFilter(sh As Worksheet)
Dim i As Integer 'номер колонки
Dim j As Integer 'номер листа
Dim k() 'массив критериев
For j = 1 To 5 'для листов 1-5
    With Worksheets(j) 'для j-ого листа
        If .Index <> sh.Index Then 'если это не активный лист, с которого уходим
            For i = 3 To 6 'для столбцов 3-6
                With sh.AutoFilter.Filters(i) 'для i-ого столбца
                    If .On Then 'если установлен фильтр
                        If .Operator = xlAnd Or .Operator = xlOr Then 'если установлен в фильтре установлено 2 значения и\или
                            'тогда на j-ом листе в i-ом столбце устанавливаем фильтр с критериями с активного листа
                            Worksheets(j).Range("A1").AutoFilter (i), Criteria1:=sh.AutoFilter.Filters(i).Criteria1, Operator:=sh.AutoFilter.Filters(i).Operator, Criteria2:=sh.AutoFilter.Filters(i).Criteria2
                        ElseIf .Operator = xlFilterValues Then 'если установлено несколько значений фильтра
                            k = sh.AutoFilter.Filters(i).Criteria1 'запоминаем критерии фильтра в массив
                            Worksheets(j).Range("A1").AutoFilter (i), Criteria1:=k, Operator:=xlFilterValues 'устанавливаем фильтры на j-ом листе в i-ом столбце
                        Else 'иначе тот случай когда установлено одно значение фильтра
                            Worksheets(j).Range("A1").AutoFilter (i), Criteria1:=sh.AutoFilter.Filters(i).Criteria1 'устанавливаем это значение
                    End If
                  Else 'если фильтр не установлен, снимаем фильтр на j-ом листе в i-ом столбце
                    If Not sh.AutoFilter Is Nothing Then
                        Worksheets(j).Range("A1").AutoFilter Field:=i
                    End If
                  End If
                End With
            Next i
        End If
    End With
Next j
End Sub

И на всех листах, где повторяются фильтры, добавила:
Код
Private Sub WorkSheet_Deactivate()
RecountFilter Me
End Sub
Буду еще тестить, но вроде работает.
Изменено: KeDa - 29.01.2016 13:06:35
 
 
 
Страницы: 1
Наверх