桌面Excel不使用ActiveX实现输入时动态过滤下拉列表咨询

代码不生效的根因 #

普通工作表单元格（即使定义了命名区域、添加了数据验证）不存在原生KeyPress事件，你写的myData_KeyPress是ActiveX控件的事件规则，对普通单元格完全无效，因此永远不会被调用。同时这类单元格事件代码必须放在对应工作表的代码模块中，放在普通工作簿模块也无法触发。

非ActiveX实现带过滤下拉列表的方案 #

前置准备 #

假设你的全量候选列表存放在Sheet2的A列（A1为表头，A2开始为所有候选值），先做过滤逻辑配置：

1. 在Sheet2的B列（可替换为任意空白列）B2单元格输入过滤公式：
   （Excel 365/2021及以上版本适用）

   =FILTER(Sheet2!$A:$A,ISNUMBER(SEARCH(Sheet1!$A$1,Sheet2!$A:$A)),"无匹配项")
   

   低版本Excel可改用辅助列+COUNTIF/SEARCH组合实现过滤。
2. 定义动态命名区域myList，引用公式为：

   =OFFSET(Sheet2!$B$2,0,0,COUNTA(Sheet2!$B:$B)-1,1)
   

VBA代码配置 #

所有代码必须放在目标单元格所在工作表的代码模块（右键工作表标签→查看代码即可进入）：

1. 初始化命名区域和数据验证：

Private Sub Worksheet_Activate()
    Dim rng As Range
    Set rng = Me.Range("A1")
    ThisWorkbook.Names.Add Name:="myData", RefersTo:=rng
    With rng.Validation
        .Delete ' 避免重复添加验证报错
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:="=myList"
        .InCellDropdown = True
    End With
End Sub

2. 输入内容后自动刷新下拉列表：

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 仅监控目标命名区域的单元格
    If Intersect(Target, Me.Range("myData")) Is Nothing Then Exit Sub
    
    Application.EnableEvents = False ' 关闭事件避免循环触发
    ' 刷新数据验证的过滤列表
    With Target.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:="=myList"
        .InCellDropdown = True
    End With
    ' 自动弹出下拉列表供选择
    Application.SendKeys "%{DOWN}"
    Application.EnableEvents = True
End Sub

效果说明 #

用户在A1单元格输入内容后按回车，下拉列表会自动过滤出所有包含输入内容的选项并直接弹出，无需额外操作。如果是Excel 365版本，也可以直接使用数据验证下拉自带的搜索功能，无需写代码即可实现输入过滤效果。

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