Excel下拉选择控制列显示/隐藏功能异常求助

问题根源 #

你的VBA代码有两个核心问题导致列全隐藏：

1. Cells.Find未准确定位表头：默认的Find方法没指定匹配规则（比如整单元格匹配）、搜索范围，大概率没找到对应的表头单元格，导致FindHdg1/2/3为空，后续Rng1/2/3也无效，执行Rng.EntireColumn.Hidden = False等于没生效，而ColsToHide是把D到最后一列全隐藏，最终只剩前面列显示。
2. 冗余的退出判断：代码重复写了两次If Intersect(Target, PayType) Is Nothing Then Exit Sub，属于无效冗余。

另外，CurrentRegion依赖连续单元格区域，若数据集中间有空行/空列，也会导致选中范围出错。而你已经明确知道各数据集的列范围，直接指定列比用Find+CurrentRegion更可靠。

修复后的代码（推荐版本） #

直接用已知列范围，避免Find方法的不确定性：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim PayType As Range
    Set PayType = Me.Range("B1") '用Me指代当前工作表，逻辑更严谨
    
    '仅保留一次退出判断
    If Intersect(Target, PayType) Is Nothing Then Exit Sub
    
    Select Case PayType.Value '明确取单元格值，避免歧义
        Case "All"
            Me.Cells.EntireColumn.Hidden = False
        Case "Cash Payments"
            Me.Cells.EntireColumn.Hidden = True
            Me.Range("D:H").EntireColumn.Hidden = False
        Case "Debit Card Payments"
            Me.Cells.EntireColumn.Hidden = True
            Me.Range("J:N").EntireColumn.Hidden = False
        Case "Credit Card Payments"
            Me.Cells.EntireColumn.Hidden = True
            Me.Range("P:T").EntireColumn.Hidden = False
    End Select
End Sub

另一种修复方案（保留Find方法） #

如果坚持要用Find定位表头，需完善参数确保准确查找：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim PayType As Range
    Set PayType = Me.Range("B1")
    
    If Intersect(Target, PayType) Is Nothing Then Exit Sub
    
    Dim FindHdg1 As Range, FindHdg2 As Range, FindHdg3 As Range
    '限定搜索表头所在行（假设表头在第1行），并开启整单元格匹配
    Set FindHdg1 = Me.Rows(1).Find(What:="Cash Payments", LookIn:=xlValues, LookAt:=xlWhole)
    Set FindHdg2 = Me.Rows(1).Find(What:="Debit Card Payments", LookIn:=xlValues, LookAt:=xlWhole)
    Set FindHdg3 = Me.Rows(1).Find(What:="Credit Card Payments", LookIn:=xlValues, LookAt:=xlWhole)
    
    Me.Cells.EntireColumn.Hidden = False
    
    Select Case PayType.Value
        Case "All"
        Case "Cash Payments"
            If Not FindHdg1 Is Nothing Then
                Me.Cells.EntireColumn.Hidden = True
                FindHdg1.CurrentRegion.EntireColumn.Hidden = False
            End If
        Case "Debit Card Payments"
            If Not FindHdg2 Is Nothing Then
                Me.Cells.EntireColumn.Hidden = True
                FindHdg2.CurrentRegion.EntireColumn.Hidden = False
            End If
        Case "Credit Card Payments"
            If Not FindHdg3 Is Nothing Then
                Me.Cells.EntireColumn.Hidden = True
                FindHdg3.CurrentRegion.EntireColumn.Hidden = False
            End If
    End Select
End Sub

注意事项 #

• 代码必须放在对应工作表的模块中（不是标准模块），否则Worksheet_Change事件不会触发。
• 修改后记得将工作簿保存为.xlsm格式，否则VBA代码会丢失。

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