UserForm ComboBox部分字符串匹配功能异常问题求助

你的代码核心问题是：每次触发ComboBox1_Change事件时，都会用过滤后的结果覆盖ComboBox的.List属性。当你通过下拉箭头选中某个项目后，ComboBox的文本变为该项目内容，此时过滤后的列表仅包含该单个项目（甚至为空），后续点击下拉箭头时没有足够的列表项展开。同时原代码中ComboBox1.value <> "False"的判断毫无意义，会干扰正常过滤逻辑，且你没有保留原始完整数据源，无法恢复全量列表。

1. 保存原始数据源 #

在用户窗体的模块级别声明变量，保存完整的字典键数组，确保每次过滤都基于原始全量数据，而非被修改后的ComboBox列表。

2. 修正事件逻辑 #

• 在窗体初始化时加载原始数据
• 修改Change事件，基于原始数据过滤，空文本时恢复全量列表
• 添加DropButtonClick事件，确保点击下拉箭头时重新生成正确的过滤列表

完整代码 #

' 用户窗体模块级变量，保存原始字典键数组
Private originalKeys As Variant
Private dic As New Dictionary ' 若你的字典为全局声明，可删除此行

Private Sub UserForm_Initialize()
    ' --------------------------
    ' 此处添加你从单元格区域加载字典的代码
    ' 示例：
    ' Dim cell As Range
    ' For Each cell In Sheet1.Range("A2:A100") ' 假设数据存储在A2:A100区域
    '     If cell.Value <> "" And Not dic.Exists(cell.Value) Then
    '         dic.Add cell.Value, cell.Value
    '     End If
    ' Next
    ' --------------------------
    
    originalKeys = dic.Keys ' 保存完整的原始键集合
    Me.ComboBox1.List = originalKeys ' 初始化ComboBox为全量列表
End Sub

Private Sub ComboBox1_Change()
    Dim filteredItems As Variant
    
    If Me.ComboBox1.Text <> "" Then
        ' 基于原始数据过滤，而非当前ComboBox的List
        filteredItems = Filter(originalKeys, Me.ComboBox1.Text, True, vbTextCompare)
        Me.ComboBox1.List = filteredItems
        Me.ComboBox1.DropDown ' 展开下拉列表
    Else
        ' 文本为空时恢复全量列表
        Me.ComboBox1.List = originalKeys
    End If
End Sub

Private Sub ComboBox1_DropButtonClick()
    ' 点击下拉箭头时，重新根据当前文本过滤
    Dim filteredItems As Variant
    
    If Me.ComboBox1.Text <> "" Then
        filteredItems = Filter(originalKeys, Me.ComboBox1.Text, True, vbTextCompare)
        Me.ComboBox1.List = filteredItems
    Else
        Me.ComboBox1.List = originalKeys
    End If
End Sub

说明 #

• 模块级变量originalKeys保存了完整的字典键数组，确保每次过滤都基于全量数据源，避免列表越缩越小的问题
• 移除了原代码中不合理的判断条件，保证过滤逻辑正常触发
• DropButtonClick事件保证用户点击下拉箭头时，无论当前文本是什么，都能生成对应的过滤列表，彻底解决选中项目后无法展开的问题

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