使用VBA禁用筛选器中的(Blanks)选项并修复列隐藏问题

需求背景 #

表格需实现：

• 筛选器中的(Blanks)选项不可选
• B列仅允许选择值4，C列仅允许选择值2

原表格规模较大，使用以下Worksheet_Calculate宏实现筛选时自动隐藏/显示空列：

Private Sub Worksheet_Calculate()
Application.ScreenUpdating = False
Columns("A:AK").Hidden = False
For i = 1 To 1000
    If Application.Subtotal(103, Columns(i)) = 1 Then Columns(i).Hidden = True
Next i
Application.ScreenUpdating = True
End Sub

但选择(Blanks)时会出现两个问题：

1. 偶发仅显示最后一行有内容的列（原因不明）
2. 选择(Blanks)的列会被隐藏，且无法撤销，需手动取消所有列的隐藏

修改后的宏代码 #

以下代码会忽略选择了(Blanks)的列，避免上述问题，同时保留原有的列隐藏逻辑：

Private Sub Worksheet_Calculate()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Set ws = Me
    Dim col As Range
    Dim hasBlankFilter As Boolean
    
    ' 先取消所有列隐藏
    ws.Columns("A:AK").Hidden = False
    
    ' 遍历目标列（A到AK）
    For Each col In ws.Columns("A:AK")
        hasBlankFilter = False
        ' 检查当前列是否启用了筛选，且包含空白筛选条件
        If col.AutoFilter Is Not Nothing Then
            On Error Resume Next ' 避免无筛选条件时出错
            hasBlankFilter = col.AutoFilter.Filters(1).On And _
                            col.AutoFilter.Filters(1).Criteria1 = "="
            On Error GoTo 0
        End If
        
        ' 如果该列没有应用空白筛选，再判断是否隐藏
        If Not hasBlankFilter Then
            ' Subtotal(103)统计可见非空单元格数量，等于1说明只有表头（假设表头在第1行）
            If Application.Subtotal(103, col) = 1 Then
                col.Hidden = True
            End If
        End If
    Next col
    
    Application.ScreenUpdating = True
End Sub

关键修改说明 #

• 新增hasBlankFilter变量，用于检测列是否应用了(Blanks)筛选（空白筛选的Criteria1为=）
• 遍历列时先判断是否有空白筛选，仅对未应用空白筛选的列执行隐藏逻辑
• 加入错误处理，避免列未启用筛选时触发错误
• 明确指定工作表对象ws = Me，增强代码稳定性

额外建议（可选） #

如果要彻底禁用(Blanks)选项，可在Worksheet_SelectionChange事件中添加筛选选项限制，从源头阻止选择空白值：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim ws As Worksheet
    Set ws = Me
    Dim filterCol As Integer
    filterCol = Target.Column
    
    ' 仅对B、C列限制筛选选项
    If filterCol = 2 Or filterCol = 3 Then
        Dim allowedVals As Variant
        If filterCol = 2 Then
            allowedVals = Array(4) ' B列仅允许选4
        Else
            allowedVals = Array(2) ' C列仅允许选2
        End If
        
        ' 重置筛选器，仅保留允许的值
        If ws.AutoFilter Is Not Nothing Then
            ws.Range(ws.Cells(1, filterCol), ws.Cells(ws.Rows.Count, filterCol).End(xlUp)). _
                AutoFilter Field:=1, Criteria1:=allowedVals, Operator:=xlFilterValues
        End If
    End If
End Sub

这段代码会在选中B或C列时，自动将筛选器限制为仅允许选择指定值，从根源上避免选择(Blanks)的情况。

内容的提问来源于stack exchange，提问作者Michal Rama