Страницы: 1
RSS
Фильтрация нескольких таблиц
 
День добрый!
Возникла потребность фильтровать таблицы в книге по значению фильтра на 1 странице.


В примере: две таблицы на разных листах. Хочу фильтровать таблицу1 на 1 листе, а таблица2 с листа 2 автоматически забирала значение фильтра.
Расширенный фильтр, дает отфильтровать таблицы 2 на листе 2 по значению таблицы 1 на листе 1, но есть недостаток приходится вбивать значение в таблицу 1 руками,  а так не хочется
Можно ли запихать значение фильтра таблицы1 в переменную, которую потом можно использовать для других таблиц. Или например сделать срез по таблице 1 и уже этот срез так же через переменную в  VBA применить на другие таблицы  :oops:  
Изменено: Александр Широкий - 18.01.2022 15:29:17
 
Александр Широкий,
а фильтровать нужно только один столбец?
таблицы всегда одинаковые?
Изменено: evgeniygeo - 19.01.2022 08:22:35
 
Да, фильтр будет только по одному столбцу (дате)
Первый столбец в таблицах всегда одинаковый, основное тело таблицы разные формул
Изменено: Александр Широкий - 19.01.2022 09:21:17
 
Александр Широкий,
к сожалению, у меня есть только ОЧЕНЬ костыльные варианты:
создаем доп столбцы c помощью функции и тем самым проверяем скрытость строки:
Код
Function hide(i)
If Rows(i.Row).Height = 0 Then
hide = "скрыта"
Else
hide = 0
End If
End Function
После этого мы можем понять в другой таблице какие даты скрыты.
Осталось придумать, как обработать событие установки фильтра, чтобы в этот момент фильтровать все таблице типа:
Код
Sub apply_autofilter_across_worksheets()
    Dim xWs As Worksheet
    On Error Resume Next
    For Each xWs In Worksheets
        xWs.Range("В1").AutoFilter 1, "=скрыта"
    Next
End Sub
Изменено: evgeniygeo - 20.01.2022 08:31:01
 
Rows(i.Row) - плохо, а Rows(i) - хорошо
Изменено: Jack Famous - 20.01.2022 09:06:26
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
, спасибо! Интересный вариант ;) попробую  
 
В модуль листа "2"
Код
Private Sub Worksheet_Activate()
    FilterActiveSheet
End Sub
Это в стандартный модуль
Код
Sub FilterActiveSheet()
    FilterSheet ActiveSheet
End Sub

Sub FilterSheet(sh As Worksheet)
    Dim dic As Object
    Set dic = GetDic(Sheets("1"))
    
    With sh
        On Error Resume Next
        .ShowAllData
        On Error GoTo 0
        .UsedRange.EntireRow.Hidden = False
    
    
        Dim y As Long
        Dim arr As Variant
        y = .Cells(.Rows.Count, 1).End(xlUp).Row
        arr = .Range(.Cells(1, 1), .Cells(y, 2))
        For y = 2 To UBound(arr, 1)
            If Not dic.Exists(arr(y, 2)) Then
                .Rows(y).Hidden = True
            End If
        Next
    End With
End Sub

Function GetDic(sh1 As Worksheet) As Object
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    With sh1
        Dim y As Long
        Dim arr As Variant
        y = .Cells(.Rows.Count, 1).End(xlUp).Row
        arr = .Range(.Cells(1, 1), .Cells(y, 2))
        
        For y = 2 To UBound(arr, 1)
            If Not .Rows(y).Hidden Then
                dic.Item(arr(y, 2)) = 0
            End If
        Next
    End With
    Set GetDic = dic
End Function
 
Отлично! Спасибо
 
Jack Famous,
согласен, поторопился  :)  
Изменено: evgeniygeo - 20.01.2022 11:21:33
Страницы: 1
Наверх