Недостаток Экселя - нельзя сохранять условия автофильтра и сбрасывать сразу все условия. Кроме того, нельзя сохранять порядок строк в автофильтре.

Задумал исправить этот недостаток.
В общем, пользователь будет работать так:
1. Становится на любую строку внутри автофильтра.
2. Щелкает на картинке, к которой привязан скрипт на vbs.
3. Скрипт запускаясь, пробегает по листу Filters, ищет где имя совпадает с переданным в командной строке скрипту параметром.
4. Запускается этот скрипт.

Т.е. пользователь описывает свой запрос на языке VBS, примерно так:
FiltClear() 'Очистить фильтр
FiltCond2("Возраст", "10" , "|", "Возраст", "20") 'Установить фильтр по возрасту
FiltSort1("Возраст") 'Отсортировать по возрасту

Код примерный ниже.


Sub FiltCond1(Field1, Criteria1)
FiltCond currSheet, Field1, Criteria1, Empty, Empty, Empty
End Sub

Sub FiltCond2(Field1, Criteria1, operator, Field2, Criteria2)
Set currSheet = ActiveSheet
FiltCond currSheet, Field1, Criteria1, operator, Field2, Criteria2
End Sub

Sub FiltSort1(Key1)
Set currSheet = ActiveSheet
FiltSort currSheet, Key1, "", ""
End Sub

Sub FiltSort2(Key1, Key2)
Set currSheet = ActiveSheet
FiltSort currSheet, Key1, Key2, ""
End Sub

Sub FiltSort3(Key1, Key2, Key3)
Set currSheet = ActiveSheet
FiltSort currSheet, Key1, Key2, Key3
End Sub

'Clear filter
Sub FiltClear()
Set currSheet = ActiveSheet
Set currAutoFilter = ActiveSheet.AutoFilter
Set currFiltRange = currAutoFilter.Range
Set currFilters = currAutoFilter.Filters
For i = 1 To currFilters.Count
Set currFilter = currFilters.Item(i)
If currFilter.On Then
currFiltRange.AutoFilter Field:=i
End If
Next
End Sub


'Apply filter condition
Sub FiltCond(Sheet, Field1, Criteria1, operator, Field2, Criteria2)
Set currAutoFilter = ActiveSheet.AutoFilter
Set currFiltRange = currAutoFilter.Range

currFilterIndex = GetAutoFilterFieldIndexByName(currAutoFilter, Field1)
If operator Then
currFilterIndex2 = GetAutoFilterFieldIndexByName(currAutoFilter, Field2)
currFiltRange.AutoFilter Field:=currFilterIndex, Criteria1:=Criteria1, operator:=operator, Field2:=Field2, Criteria2:=Criteria2
currFiltRange.AutoFilter ""
Else
currFiltRange.AutoFilter Field:=currFilterIndex, Criteria1:=Criteria1
End If

' currSheet.Range(currentFiltRange).AutoFilter Field:=col, Criteria1:=Criteria1
End Sub


'Sort by 1-3 fields of autofilter
Sub FiltSort(Sheet, Key1, Key2, Key3)
Set currAutoFilter = ActiveSheet.AutoFilter
Set currFiltRange = currAutoFilter.Range
Set currFilters = currAutoFilter.Filters

If InStr(1, Key1, "+") <> 0 Then
Order1 = xlAscending
ElseIf InStr(1, Key1, "-") <> 0 Then
Order1 = xlDescending
Else
Order1 = xlAscending
End If
Key1 = Replace(Key1, "+", "")
Key1 = Replace(Key1, "-", "")

If InStr(1, Key2, "+") <> 0 Then
Order2 = xlAscending
ElseIf InStr(1, Key2, "-") <> 0 Then
Order2 = xlDescending
Else
Order2 = xlAscending
End If
Key2 = Replace(Key2, "+", "")
Key2 = Replace(Key2, "-", "")

If InStr(1, Key3, "+") <> 0 Then
Order1 = xlAscending
ElseIf InStr(1, Key3, "-") <> 0 Then
Order3 = xlDescending
Else
Order3 = xlAscending
End If
Key3 = Replace(Key3, "+", "")
Key3 = Replace(Key3, "-", "")


Key1Index = GetAutoFilterFieldIndexByName(currAutoFilter, Key1)
If Key2 = "" Then
'Have 1 fields of sort
currFiltRange.Sort currFiltRange.Cells(1, Key1Index), Header:=xlGuess, Order1:=Order1
Else
Key2Index = GetAutoFilterFieldIndexByName(currAutoFilter, Key2)
If Key3 = "" Then
'Have 2 fields of sort
currFiltRange.Sort Key1:=currFiltRange.Cells(1, Key1Index), Header:=xlGuess, Order1:=Order1, Key2:=currFiltRange.Cells(1, Key2Index), Order2:=Order2
Else
Key3Index = GetAutoFilterFieldIndexByName(currAutoFilter, Key3)
'Have 3 fields of sort
currFiltRange.Sort Key1:=currFiltRange.Cells(1, Key1Index), Header:=xlGuess, Order1:=Order1, Key2:=currFiltRange.Cells(1, Key2Index), Order2:=Order2, Key3:=currFiltRange.Cells(1, Key3Index), Order3:=Order3
End If
End If

End Sub


Function GetAutoFilterFieldIndexByName(currAutoFilter, Name)
GetAutoFilterFieldIndexByName = 0
Set currFiltRange = currAutoFilter.Range
Set currFilters = currAutoFilter.Filters
For i = 1 To currFilters.Count
Set currFilter = currFilters.Item(i)
Set currFilterHeader = currFiltRange.Cells(1, i)
currFilterHeaderName = Trim(currFilterHeader.Value)
If currFilterHeaderName = Name Then
GetAutoFilterFieldIndexByName = i
End If
Next
End Function



Sub test()
FiltCond1 "Задача", "Люда Кипр"
FiltSort1 "Задача"
End Sub


В колонках играет: Михаил Круг - Кумовая {Михаил Круг - Кумовая}

LI 5.09.15