Deepseek太强了！等了10年的Excel模糊下拉，竟然5分钟就搞定了

今天跟大家分享下我们如何通过Deepseek来编写VBA代码，制作模糊搜索的下拉菜单，这个等来十来年的功能，用Deepseek竟然几分钟就搞定了，不得不感叹AI工具的强大，我们以后能干的过AI吗，这真的是个问题啊？

一、准备工作

1. 首先我们需先新建一个XLSM格式的Excel文件，这个文件能否保存宏代码

2. 打开文件，新建一个sheet，将名称更改数据：数据源

3. 在数据源这个sheet中的D列这个区域中来填写下拉的内容

4. 新建第二个sheet，我们是需要在这里实现模糊匹配的下拉菜单的

二、创建窗体

首先点击【开发工具】随后我们需要在里面找到【插入】选择【ActiveX控件】

在里面找到文本框（TextBox）和列表框（ListBox）直接插入即可，位置大小可以随意设置

之后需要点击【设计模式】退出设计模式，不然的话窗体不会生效。

三、使用代码

按下快捷键ALT+F11调出VBA的设置窗口，之后会在右侧看到对应的sheet名称，我们需要找到想要实现这个效果的sheet，在这里是sheet1，所以我们就双击sheet1，复制代码，将其直接按下快捷键Ctrl+V粘贴，最后按下快捷键Ctrl+S保存一下就可以了

设置完毕后，鼠标三击单元格，激活文本框，在里面输入即可自动匹配自己需要的数据

四、代码展示

' 在模块顶部声明常量

Const DATA_SHEET As String = "数据源" ' 数据源工作表名称

Const DATA_COL As String = "D" ' 数据源所在列

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

' ================ 核心功能函数 ================

' 验证目标单元格有效性

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

' 重置控件状态

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

' 加载数据源

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

' 执行模糊搜索

Private Sub UpdateSearchResults(searchText As String)

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

' 重新获取数据源

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

' 执行模糊匹配

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 "无匹配结果"

End If

End Sub

五、其他事项

默认是在A列来实现这个效果的，如果你想在其他列实现这个模糊的搜索下拉，就需要对代码做一下修改，只需将前3行修改为自己对应的数据即可

Const DATA_SHEET As String = "数据源" ' 数据源工作表名称Const DATA_COL As String = "D" ' 数据源所在列Const TARGET_COL As Integer = 1 ' 目标列（A列为1）