如何使用VBA在Excel 2016中获取筛选条件?



我正在开发一个 Excel 2016 VBA 宏,它将过滤器应用于标题列。之后,用户应用筛选条件。我希望能够在 VBA 中检索用户应用的过滤条件并将其保存到字符串数组中。有没有办法访问筛选条件?

我检查了这个问题并几乎复制了代码的第一部分,唯一的问题是你没有得到它所应用的字段,这可能会有问题。

Dim sht As Worksheet
Set sht = ActiveSheet
With sht.AutoFilter
With .Filters
ReDim filtarr(1 To .Count, 1 To 3)
For f = 1 To .Count
With .Item(f)
If .On Then
filtarr(f, 1) = .Criteria1
Debug.Print .Criteria1
If .Operator Then
filtarr(f, 2) = .Operator
filtarr(f, 3) = .Criteria2
Debug.Print .Operator & ", " & .Criteria2
End If
End If
End With
Next f
End With
End With

我想在讨论中补充一点。 在调查如何"返回"过滤器状态时,我发现了这个(以及其他出色的帮助来源(。 就我而言,我想在工作表上的单元格中显示过滤器状态。

正如我所说,这个问题和许多其他类似的问题非常有用。 由此,我能够构建下面代码中显示的函数。

我向它传递我想要过滤状态的表的名称......因此,它作为 RANGE 传入,然后需要在 PARENT(工作表(中查找信息。 这是因为 SHEET 上可能有多个表,所以我不能只使用 SHEET 本身来获取自动筛选信息。

这很有效,除了一件事:如果工作表上的活动单元格不在相关表格中,则该函数会将过滤器的数量视为零(在下面的示例中为 WholeTable.Parent.Autofilter.Filters.Count(。我不明白为什么会这样,也不明白如何防止它。 如果活动单元格在表格范围内,则它可以完美运行。

任何提示将不胜感激!

法典:


Public Function AutoFilterCriteria(ByVal WholeTable As Range) As String
On Error Resume Next
If WholeTable.Parent.AutoFilter 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 WholeTable.Parent.AutoFilter.Filters.Count         ' loop through each column of the table
Dim ThisFilt As Filter
Set ThisFilt = WholeTable.Parent.AutoFilter.Filters(iFilt)      ' look at each filter
On Error Resume Next
With ThisFilt
If .On Then
If FirstOne Then LongStr = LongStr & " AND "            ' Get column title
LongStr = LongStr & "[" & WholeTable.Parent.Cells(WholeTable.Row - 1, WholeTable.Column + iFilt - 1).Value & ":"
On Error GoTo Handle
If .Operator = xlFilterValues Then                      ' dont really care to enumerate multiples, just show "multiple"
LongStr = LongStr & "<Multiple>]"
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

代码将是这样的。字段的代码是单元格(1,f(。

Dim sht As Worksheet
Set sht = ActiveSheet
With sht.AutoFilter
With .Filters
ReDim filtarr(1 To .Count, 1 To 4) ' change array
For f = 1 To .Count
With .Item(f)
If .On Then
filtarr(f, 1) = .Criteria1
filtarr(f, 4) = Cells(1, f) 'field
Debug.Print .Criteria1, Cells(1, f)
If .Operator Then
filtarr(f, 2) = .Operator
filtarr(f, 3) = .Criteria2
Debug.Print .Operator & ", " & .Criteria2
End If
End If
End With
Next f
End With
End With

最新更新