如何在EXCEL单元格内实现输入数据下拉菜单自动匹配数据源中的内容

Answer 1

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