powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Получение критериев автофильтра
2 сообщений из 2, страница 1 из 1
Получение критериев автофильтра
    #37170490
sergeyvg
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Написал функцию получения критериев автофильтра.

Если фильтруемая колонка с датами, то:
- в Еселе2003, Еселе2007 если выбрать условие, например «больше 01.01.2010», получаю «Колонка 'х' >40179;»;
- в Еселе2007 при выборе конкретной даты получаю objF.Count = 0, т.е. «Колонка '4' массив дат;»;
- в Еселе2010 не пробовал, его у меня нет. Интересно как функция отработает в нем.
Как получить удобоваримый результат в такой ситуации, например "Колонка 'х' >01.01.2010;»?

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
Public Function FiltersCriteria(Optional varSheet As Worksheet) As String
Dim objWsht As Worksheet, objF As Filter, I As Long, J As Long, strOut As String, FlagCount As Boolean

If varSheet Is Nothing Then Set objWsht = ActiveSheet Else Set objWsht = varSheet
If Not objWsht.AutoFilter Is Nothing Then
  I =  0 : strOut = ""
  For Each objF In objWsht.AutoFilter.Filters
    I = I +  1 
    If objF.On Then
      strOut = strOut & " Колонка '" & objWsht.AutoFilter.Range.Cells( 1 , I).Value & "' "
      FlagCount = True
      If Val(Application.Version) >  11  Then 'т.к. в Excel2007 на даты фильтр странный
        If objF.Count =  0  Then
          strOut = strOut & "массив дат"
          FlagCount = False
        End If
      End If
      If FlagCount Then
        If VarType(objF.Criteria1) >  8192  Then
          For J =  1  To UBound(objF.Criteria1)
            If J >  1  Then strOut = strOut & ","
            If J >  3  Then strOut = strOut & "...": Exit For
            strOut = strOut & objF.Criteria1(J)
          Next J
        Else
          If VarType(objF.Criteria1) <>  9  Then strOut = strOut & objF.Criteria1
        End If
        If objF.Operator Then
          strOut = strOut & " " & Choose(objF.Operator, _
            "И", "ИЛИ", "", "", "", _
            "", "", "на цвет ячеек", "на цвет шрифта", "на значок условного форматирования", _
            "динамический фильтр", "нет цвета ячеек(нет заливки)", "нет цвета шрифта(Auto)", "нет значка условного форматирования") & " "
          Select Case objF.Operator
          Case  1 ,  2 
            strOut = strOut & objF.Criteria2
          End Select
        End If
      End If
      strOut = strOut & ";"
    End If
  Next objF
End If
FiltersCriteria = strOut
End Function 'FiltersCriteria

Пример вызова из модуля листа, содержащего фильтр
Код: plaintext
1.
2.
3.
Private Sub Worksheet_Calculate()
Range("A4") = FiltersCriteria
End Sub
...
Рейтинг: 0 / 0
Получение критериев автофильтра
    #37171092
скукотища
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
sergeyvg,
sergeyvgКак получить удобоваримый результат в такой ситуации, например "Колонка 'х' >01.01.2010;»?

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
' вместо простого:
strOut = strOut & objF.Criteria1

' использовать такое:
Dim k%
' ...
k =  2 : Do Until Mid(objF.Criteria1; k) Like "#*": k = k +  1 : Loop
strOut = strOut & Left(objF.Criteria1; k -  1 ) & CDate(Mid(objF.Criteria1; k))
...
Рейтинг: 0 / 0
2 сообщений из 2, страница 1 из 1
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Получение критериев автофильтра
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]