'\===============================================================================================
'-----------------------------------------------------------------------------------------------
'Call filters_column_Cri(oSh:=ActiveSheet, int_Cln:=15, strCri:="1")
'\-----------------------------------------------------------------------------------------------
Sub filters_column_Cri(ByVal oSh As Worksheet, _
ByVal int_Cln As Integer, _
ByVal strCri As String)
With oSh
Lng_ClnEnd = .Cells(1, 256).End(xlToLeft).Column
Lng_RowEnd = .Columns(1).Rows(1048576).End(xlUp).Row
Set rRange = Range(.Cells(Lng_RowEnd, 1), .Cells(Lng_RowEnd, Lng_ClnEnd))
End With
rRange.AutoFilter Field:=int_Cln, Criteria1:=strCri
Set rRange = Nothing
End Sub
'\-----------------------------------------------------------------------------------------------
'Фильтр_установить/сбросить
Private Sub Cb_Filters_Click()
Dim iNbCln As Long: iNbCln = ActiveCell.Column
Dim iNbRow As Long: iNbRow = Columns(iNbCln).Rows(Rows.Count).End(xlUp).Row
Dim vVal As Variant: vVal = ActiveCell.value
Dim sVal As String: sVal = vVal
Dim strAssress As String
If Len(sVal) = 0 Then Exit Sub
strAssress = Range(Cells(1, iNbCln), Cells(iNbRow, iNbCln)).Address
If Cb_Filters.Caption = "Фильтр" Then
ActiveSheet.Range(strAssress).AutoFilter Field:=9, Criteria1:=sVal
Cb_Filters.Caption = sVal
Else
ActiveSheet.Range(strAssress).AutoFilter Field:=9
Cb_Filters.Caption = "Фильтр"
End If
ActiveCell.Copy
End Sub
'Sub Фильтр_установить()
' Selection.Copy
' ActiveSheet.Range("$A$1:$Q$6361").AutoFilter Field:=9, Criteria1:= _
' "659174920214"
'End Sub
'Sub Фильтр_сбросить()
' ActiveSheet.Range("$A$1:$Q$6361").AutoFilter Field:=9
'End Sub
''============================================================
Sub SkritStrelkiAvtofiltra()
Call EventsChange(False)
Фильтр = FnFiltersSheet(ThisWorkbook.Sheets("Points"), 2, 1)
iNbClnEndFilter = ThisWorkbook.Sheets("Points").Cells(2, 256).End(xlToLeft).Column
With Range(ThisWorkbook.Sheets("Points").Cells(2, 1), ThisWorkbook.Sheets("Points").Cells(2, iNbClnEndFilter))
' .AutoFilter
.AutoFilter Field:=2, VisibleDropDown:=False
.AutoFilter Field:=22, VisibleDropDown:=False
For i = 4 To 19
.AutoFilter Field:=i, VisibleDropDown:=False
Next i
' .AutoFilter Field:=6, VisibleDropDown:=True
End With
Call EventsChange(True)
End Sub
'===============================================================================================
'----------------------------------------------------------------------------------------------------
'Sub test_FreezePanes_and_Filters()
'Set rCell = ActiveCell '.Address
' Call FreezePanes_and_Filters(rCell:=ActiveCell)
'End Sub
Sub FreezePanes_and_Filters(ByVal rCell As Range)
Dim i As Long, Lng_ClnStart As Long, Lng_ClnEnd As Long, bln_Filters As Boolean
'активируем книгу
rCell.Parent.Parent.Activate
'активируем лист
rCell.Parent.Activate
rCell.Select
'закрепляем области
If ActiveWindow.FreezePanes Then ActiveWindow.FreezePanes = False 'снять
ActiveWindow.FreezePanes = True 'установить заново
'определяем шапку
'последний столбец
Lng_ClnEnd = Cells(rCell.Row - 1, 256).End(xlToLeft).Column
'первый столбец
For i = rCell.Column To 1 Step -1
If Len(Cells(rCell.Row - 1, i)) > 0 Then Lng_ClnStart = i
Next i
'устанавливаем фильтр
bln_Filters = fun_FiltersSheet(oSh:=rCell.Parent, iNbRowStartFilter:=rCell.Row - 1, iNbClnStartFilter:=Lng_ClnStart)
End Sub
'===============================================================================================
'### Установить фильтр
'Фильтр = fun_FiltersSheet(ThisWorkbook.Sheets("Data"), 1, 1)
Function fun_FiltersSheet(oSh As Worksheet, _
ByVal iNbRowStartFilter As Integer, _
ByVal iNbClnStartFilter As Integer) As Boolean
'Установить фильтр
'iNbRowStartFilter - шапка
'iNbClnStartFilter - столбец начала фильтра
On Error Resume Next
Dim iNbCol As Integer
With oSh
.Cells.EntireColumn.Hidden = False
.Cells.EntireRow.Hidden = False
'конец фильра
iNbClnEndFilter = .Cells(iNbRowStartFilter, 256).End(xlToLeft).Column
CellSelect = Range(.Cells(iNbRowStartFilter, iNbClnStartFilter), .Cells(iNbRowStartFilter, iNbClnEndFilter)).Address
If .AutoFilterMode Then
.Range(CellSelect).AutoFilter
.Range(CellSelect).AutoFilter
Else
.Range(CellSelect).AutoFilter
End If
If .AutoFilterMode Then
fun_FiltersSheet = True
Else
.Range("A1").AutoFilter
End If
End With
End Function
'===============================================================================================
