Нахождение статуса произвольно примененного автофильтра в Excel 2016 - PullRequest
Новая
       6

Нахождение статуса произвольно примененного автофильтра в Excel 2016

0 голосов
/ 21 января 2019

Я хотел что-то вернуть.

Недавно ответили на вопрос Этот вопрос:

Я нашел решение своей проблемы.

Вот функция VBA, которая возвращает статус автофильтра в виде строки.

Вы передаете ему ИМЯ таблицы, которая появляется где-то на рабочем листе. Может быть больше одного, и функция «находит» подходящий.

У меня была проблема, когда, если бы активной ячейки НЕ было в выбранной таблице, она бы не работала. Решение состояло в том, чтобы сопоставить адрес таблицы со всеми таблицами на рассматриваемом листе.

Пока это работает. Пробовал несколькими способами.

В любом случае, я подумал, что постараюсь поделиться этим с сообществом, так как нашел несколько связанных постов, которые помогли создать это.

Вот оно: 

 Public Function AutoFilterCriteria(ByVal WholeTable As Range) As String

On Error Resume Next

Dim ThisAutoFilter As AutoFilter, iObj As Integer, Found As Boolean
Found = False
For iObj = 1 To WholeTable.Parent.ListObjects.Count
    If WholeTable.Address = WholeTable.Parent.ListObjects(iObj).DataBodyRange.Address Then
        Set ThisAutoFilter = WholeTable.Parent.ListObjects(iObj).AutoFilter
        Found = True
        Exit For
    End If
Next

If Not Found Then
    AutoFilterCriteria = "Not Found !!!"
    On Error GoTo 0
    Exit Function
ElseIf ThisAutoFilter Is Nothing Then                     ' if no filter is applied
    AutoFilterCriteria = "None"
    On Error GoTo 0
    Exit Function
End If

Dim LongStr As String, FirstOne As Boolean
LongStr = ""
FirstOne = False

Dim iFilt As Integer
For iFilt = 1 To ThisAutoFilter.Filters.Count         ' loop through each column of the table
    Dim ThisFilt As Filter
    Set ThisFilt = ThisAutoFilter.Filters(iFilt)      ' look at each filter
    On Error Resume Next
    With ThisFilt
        If .On Then
            If FirstOne Then LongStr = LongStr & " AND "            ' Get colun title
            LongStr = LongStr & "[" & WholeTable.Parent.Cells(WholeTable.Row - 1, WholeTable.Column + iFilt - 1).Value & ":"
            On Error GoTo Handle
            If .Operator = xlFilterValues Then                      ' for multiple, loop thru each one
                Dim iCrit As Integer
                For iCrit = 1 To UBound(ThisFilt.Criteria1) - 1
                    LongStr = LongStr & .Criteria1(iCrit) & " OR "
                Next
                LongStr = LongStr & .Criteria1(UBound(ThisFilt.Criteria1)) & "]"    ' the last one doesn't get the "OR"
            ElseIf .Operator = 0 Then
                LongStr = LongStr & .Criteria1 & "]"
            ElseIf .Operator = xlAnd Then
                LongStr = LongStr & .Criteria1 & " AND " & .Criteria2 & "]"
            ElseIf .Operator = xlOr Then
                LongStr = LongStr & .Criteria1 & " OR " & .Criteria2 & "]"
            End If
            On Error GoTo 0
            FirstOne = True
        End If
    End With
Next

AutoFilterCriteria = LongStr
On Error GoTo 0
Exit Function

Handle:
AutoFilterCriteria = "! Error !"
On Error GoTo 0

End Function

Вы можете использовать это в формуле на листе: = AutoFilterCriteria (some_named_table)

Вы можете использовать это в коде так:

Dim S as String S = AutoFilterCriteria (ActiveSheet.ListObjects ( "some_named_table"). DataBodyRange)

Вывод похож на: [Столбец1: = b ИЛИ = d ИЛИ = e] И [Столбец 4: = 11]

Я надеюсь, что кто-то еще может найти это полезным. Ура!

...