Option Explicit
Function FilterCrit() As String
Dim i As Long
Dim ws As Worksheet
Dim Filter As String
'Application.Volatile
Set ws = ThisWorkbook.Worksheets(1)
If Not ws.FilterMode Then
FilterCrit = "not filtered"
Exit Function
End If
For i = 1 To ws.AutoFilter.Filters.Count
If ws.AutoFilter.Filters(i).On Then
FilterCrit = FilterCrit & "Filter on column " & i & Chr(10)
End If
Next i
End Function
Sub test()
Call markFilter(ActiveSheet)
End Sub
Sub markFilter(wks As Worksheet)
Dim lFilCol As Long
With wks
If .AutoFilterMode Then
For lFilCol = 1 To .AutoFilter.Filters.Count
'/ If filter is applied then mark the header as bold and font color as red
If .AutoFilter.Filters(lFilCol).On Then
.AutoFilter.Range.Columns(lFilCol).Cells(1, 1).Font.Color = vbRed
.AutoFilter.Range.Columns(lFilCol).Cells(1, 1).Font.Bold = True
Else
'/ No Filter. Column header font normal and black.
.AutoFilter.Range.Columns(lFilCol).Cells(1, 1).Font.Color = vbBlack
.AutoFilter.Range.Columns(lFilCol).Cells(1, 1).Font.Bold = False
End If
Next
Else
'/ No Filter at all. Column header font normal and black.
.UsedRange.Rows(1).Font.Color = vbBlack
.UsedRange.Rows(1).Font.Bold = False
End If
End With
End Sub
Sub Active_Filter()
Dim Sht As Worksheet
Dim lngCount As Long
Dim i As Long
Set Sht = ActiveSheet
If Sht.FilterMode Then
lngCount = Sht.AutoFilter.Filters.Count
' // Go through each column look for active Filter
For i = 1 To lngCount Step 1
If Sht.AutoFilter.Filters(i).On Then
Debug.Print "Filter is set on " & Sht.Columns(i).Address
End If
Next i
End If
End Sub
4条答案
按热度按时间yc0p9oo01#
如果您只需要应用筛选器的列的简单列表,则以下VBA代码可能就足够了:
这将迭代列,如果在这些列中的任何一列上应用了过滤器,那么它将被列出。
默认情况下,所有UDF user defined functions都不是volatile,因此不会自动重新计算。但是,您可以强制它们使用Application.Volatile自动重新计算。但强烈建议不要使用此选项,因为它会严重降低Excel文件的速度。此处推荐替代解决方案:Alternative to Application.Volatile to auto update UDF
23c0lvtd2#
这将突出显示包含活动筛选器的列。这段代码只是粗体和设置字体颜色红色,但你可以修改风格的变化,根据您的需要。
xkftehaa3#
示例
alen0pnh4#
数据>排序和筛选>高级:过滤栏位于屏幕中间。