如何在EXCEL單元格內實現輸入數據下拉菜單自動匹配數據源中的內容

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