今天跟大家分享下我們?nèi)绾瓮ㄟ^Deepseek來編寫VBA代碼，制作模糊搜索的下拉菜單，這個等來十來年的功能，用Deepseek竟然幾分鐘就搞定了，不得不感嘆AI工具的強大，我們以后能干的過AI嗎，這真的是個問題??？

一、準備工作

1. 首先我們需先新建一個XLSM格式的Excel文件，這個文件能否保存宏代碼

2. 打開文件，新建一個sheet，將名稱更改數(shù)據(jù)：數(shù)據(jù)源

3. 在數(shù)據(jù)源這個sheet中的D列這個區(qū)域中來填寫下拉的內(nèi)容

4. 新建第二個sheet，我們是需要在這里實現(xiàn)模糊匹配的下拉菜單的

二、創(chuàng)建窗體

首先點擊【開發(fā)工具】隨后我們需要在里面找到【插入】選擇【ActiveX控件】

在里面找到文本框（TextBox）和列表框（ListBox）直接插入即可，位置大小可以隨意設(shè)置

之后需要點擊【設(shè)計模式】退出設(shè)計模式，不然的話窗體不會生效。

三、使用代碼

按下快捷鍵ALT+F11調(diào)出VBA的設(shè)置窗口，之后會在右側(cè)看到對應(yīng)的sheet名稱，我們需要找到想要實現(xiàn)這個效果的sheet，在這里是sheet1，所以我們就雙擊sheet1，復(fù)制代碼，將其直接按下快捷鍵Ctrl+V粘貼，最后按下快捷鍵Ctrl+S保存一下就可以了

設(shè)置完畢后，鼠標三擊單元格，激活文本框，在里面輸入即可自動匹配自己需要的數(shù)據(jù)

四、代碼展示

' 在模塊頂部聲明常量

Const DATA_SHEET As String = "數(shù)據(jù)源" ' 數(shù)據(jù)源工作表名稱

Const DATA_COL As String = "D" ' 數(shù)據(jù)源所在列

Const TARGET_COL As Integer = 1 ' 目標列（A列為1）

' 主選擇事件

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not IsValidTarget(Target) Then

HideControls

Exit Sub

End If

ResetControls

PositionControls Target

LoadData

End Sub

' 輸入實時處理

Private Sub TextBox1_Change()

UpdateSearchResults TextBox1.Text

End Sub

' 列表點擊處理

Private Sub ListBox1_Click()

If ListBox1.ListIndex = -1 Then Exit Sub

ActiveCell.Value = ListBox1.Value

HideControls

End Sub

' ================ 核心功能函數(shù) ================

' 驗證目標單元格有效性

Private Function IsValidTarget(Target As Range) As Boolean

IsValidTarget = (Target.Column = TARGET_COL) And _

(Target.Row >= 2) And _

(Target.Count = 1)

End Function

' 隱藏控件

Private Sub HideControls()

ListBox1.Visible = False

TextBox1.Visible = False

ListBox1.Clear

TextBox1.Text = ""

End Sub

' 重置控件狀態(tài)

Private Sub ResetControls()

TextBox1.Visible = True

ListBox1.Visible = True

TextBox1.Text = ""

ListBox1.Clear

End Sub

' 定位控件位置

Private Sub PositionControls(Target As Range)

' 文本框位置（覆蓋單元格）

With TextBox1

.Top = Target.Top

.Left = Target.Left

.Width = Target.Width

.Height = Target.Height

End With

' 列表框位置（下方展開）

With ListBox1

.Top = Target.Top + Target.Height

.Left = Target.Left

.Width = Target.Width * 1.5

.Height = Target.Height * 8

End With

End Sub

' 加載數(shù)據(jù)源

Private Sub LoadData()

Dim arr

With Worksheets(DATA_SHEET)

Dim lastRow As Long

lastRow = .Cells(.Rows.Count, DATA_COL).End(xlUp).Row

If lastRow < 2 Then Exit Sub

arr = .Range(DATA_COL & "2:" & DATA_COL & lastRow).Value

End With

ListBox1.List = arr

End Sub

' 執(zhí)行模糊搜索

Private Sub UpdateSearchResults(searchText As String)

Dim arr, results(), i As Long, k As Long

' 重新獲取數(shù)據(jù)源

With Worksheets(DATA_SHEET)

Dim lastRow As Long

lastRow = .Cells(.Rows.Count, DATA_COL).End(xlUp).Row

If lastRow < 2 Then Exit Sub

arr = .Range(DATA_COL & "2:" & DATA_COL & lastRow).Value

End With

' 清空搜索條件時顯示全部

If Trim(searchText) = "" Then

ListBox1.List = arr

Exit Sub

End If

' 執(zhí)行模糊匹配

ReDim results(1 To UBound(arr))

For i = 1 To UBound(arr)

If InStr(1, arr(i, 1), searchText, vbTextCompare) > 0 Then

k = k + 1

results(k) = arr(i, 1)

End If

Next

' 更新列表框

ListBox1.Clear

If k > 0 Then

ReDim Preserve results(1 To k)

ListBox1.List = results

Else

ListBox1.AddItem "無匹配結(jié)果"

End If

End Sub

五、其他事項

默認是在A列來實現(xiàn)這個效果的，如果你想在其他列實現(xiàn)這個模糊的搜索下拉，就需要對代碼做一下修改，只需將前3行修改為自己對應(yīng)的數(shù)據(jù)即可

Const DATA_SHEET As String = "數(shù)據(jù)源" ' 數(shù)據(jù)源工作表名稱Const DATA_COL As String = "D" ' 數(shù)據(jù)源所在列Const TARGET_COL As Integer = 1 ' 目標列（A列為1）