День добрый! Возникла потребность фильтровать таблицы в книге по значению фильтра на 1 странице.
В примере: две таблицы на разных листах. Хочу фильтровать таблицу1 на 1 листе, а таблица2 с листа 2 автоматически забирала значение фильтра. Расширенный фильтр, дает отфильтровать таблицы 2 на листе 2 по значению таблицы 1 на листе 1, но есть недостаток приходится вбивать значение в таблицу 1 руками, а так не хочется Можно ли запихать значение фильтра таблицы1 в переменную, которую потом можно использовать для других таблиц. Или например сделать срез по таблице 1 и уже этот срез так же через переменную в VBA применить на другие таблицы
Александр Широкий, к сожалению, у меня есть только ОЧЕНЬ костыльные варианты: создаем доп столбцы 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
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
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