如何在EXCEL单元格内实现输入数据下拉菜单自动匹配数据源中的内容？
就比如在sheet1中有个食物名称表，当我在sheet2 F3中输入鱼时，能够自动出现下拉菜单并筛选出sheet1D列中带有“鱼”字的食物名称
如果不用下拉菜单，用一道公式搞定：
在Sheet2的F4输入
IF(F$3="","",INDEX(Sheet1!D:D,SMALL(IF(ISNUMBER(FIND(F$3,Sheet1!D$1:D$100)),ROW($1:$100),4^8),ROW(1:1)))&"")
数组公式，输入后先不要回车，按Ctrl+Shift+Enter结束计算，再向下填充。
温馨提示：答案为网友推荐，仅供参考
第1个回答 2021-07-14
Private Sub worksheet_SelectionChange(ByVal Target As Range)
'启用EXCEL宏使用的环境，具体方法可问度娘；
'按ALT+F11打开VBE编辑器，找到左侧VBAproject工程树下方的（sheet2）表；
'双击该表，将代码粘贴进表右侧代码窗，保存。
'文件另存为.XLSM或.xls格式
Dim d, iRow%, i%
Set d = CreateObject("scripting.dictionary")
arr = Sheets("Sheet1").Range("D2").CurrentRegion '表1食物清单，表首在D2
'***********************事件触发设置****************************
'所选单元格数量只能是1个
If Target.Rows.Count * Target.Columns.Count > 1 Then Exit Sub
'所选单元格内容非空
If Len(Target) = 0 Then Exit Sub
'所选单元格位于F列
Set Rng = Intersect(Target, Columns("F:F"))
If Rng Is Nothing Then Exit Sub
'删除所选单元格中存在的有效性设置（初始化）
Target.Validation.Delete
'将表1的D列食物清单中包含F列所选单元格的文字的不重复项写入字典
For i = 2 To UBound(arr)
If InStr(arr(i, 1), Target) Then
If Not d.exists(arr(i, 1)) Then
d(arr(i, 1)) = ""
End If
End If
Next i
'***********************有效性设置******************************
If d.Count > 0 Then
With Target.Validation
.Add 3, 1, 1, Formula1:=Join(d.keys, ",")
.IMEMode = xlIMEModeNoControl
.ErrorMessage = "" '取消错误提示
.ShowError = False '取消错误提示
End With
End If
d.RemoveAll:Set d = Nothing
End Sub追问
'启用EXCEL宏使用的环境，具体方法可问度娘；
'按ALT+F11打开VBE编辑器，找到左侧VBAproject工程树下方的（sheet2）表；
'双击该表，将代码粘贴进表右侧代码窗，保存。
'文件另存为.XLSM或.xls格式
Dim d, iRow%, i%
Set d = CreateObject("scripting.dictionary")
arr = Sheets("Sheet1").Range("D2").CurrentRegion '表1食物清单，表首在D2
'***********************事件触发设置****************************
'所选单元格数量只能是1个
If Target.Rows.Count * Target.Columns.Count > 1 Then Exit Sub
'所选单元格内容非空
If Len(Target) = 0 Then Exit Sub
'所选单元格位于F列
Set Rng = Intersect(Target, Columns("F:F"))
If Rng Is Nothing Then Exit Sub
'删除所选单元格中存在的有效性设置（初始化）
Target.Validation.Delete
'将表1的D列食物清单中包含F列所选单元格的文字的不重复项写入字典
For i = 2 To UBound(arr)
If InStr(arr(i, 1), Target) Then
If Not d.exists(arr(i, 1)) Then
d(arr(i, 1)) = ""
End If
End If
Next i
'***********************有效性设置******************************
If d.Count > 0 Then
With Target.Validation
.Add 3, 1, 1, Formula1:=Join(d.keys, ",")
.IMEMode = xlIMEModeNoControl
.ErrorMessage = "" '取消错误提示
.ShowError = False '取消错误提示
End With
End If
d.RemoveAll:Set d = Nothing
End Sub追问
谢谢你的回答，我试了下在运行时出现了错误提示，是什么原因呢
首先检查下IE浏览器下关于ACTIVEX的设置，选择“Internet选项”-“本地Internet”-“自定义”-在“安全设置”下找到，ACTIVEX相关项并启用。
第1步设置后若继续无效，则电脑可能缺少相应的dll文件。可以根据操作系统结合“ACTIVEX 429错误”在网上下载相应DLL或对DLL重新注册，最好让网管或懂电脑的帮助处理下，这个几句话解释不了。但千万不要去重装系统。
第2个回答 2021-07-14
自带没有这样的功能，写代码可以实现类似的功能
第3个回答 2021-07-14
这个要用代码和文本框辅助输入的啊！
第4个回答 2021-07-14
需要写VBA，文件给我来改，什么你问怎么给我，你那么聪明