具体要求为：
根据部分录入的“材料名称”字段，自动列表显示“材料列表”中，根据所录入的部分或全部文字匹配的材料名称（例如：录入“镜”字，即显示所有材料名称中包含“镜”这个字的所有材料名称列表），选择材料名称后，再自动读取对应的“材料编码”、“单位”字段。
网上查询了很多资料后，总结出来了实现方法，在这里进行记录，以备后期有需求时再次调用。
第一步：新建excel文件，并新建三个表单（Sheet1，Sheet2，Sheet3），将Sheet2重命名为“导入数据”，将Sheet3重命名为“数据源”，“数据源”中所设定的表格格式如下：
其中B列是需要在Sheet1表中进行模糊查找数据所在列，然后将文件保存为“启用宏的工作簿(*.xlsm)”。
第二步：在Sheet1表中，点击“开发工具”——》“插入”——》“列表框(ActiveX控件)”，在需要查找数据的字段处，拉出所需要列表框控件的大小，并使用默认的“ListBox1”名称。
第三步：列表框大小确认后，再次点击“开发工具”——》“插入”——》“文本框(ActiveX控件)”，在刚才所拉出的列表框下方，拉出所需要文本框控件的大小，并使用默认的“TextBox1”名称。
第四步，点击“开发工具”——》“Visual Basic”，打开VB编辑器，在左侧列表Sheet1上鼠标右键点击，选择“查看代码”
第五步，在右侧弹出的窗口，复制粘贴如下代码：
Const DATA_SHEET As String = "数据源" ' 数据源工作表名称
Const DATA_COL As String = "B" ' 数据源所在列
Const TARGET_COL As Integer = 3 ' 目标列（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 * 2
End With
' 列表框位置（下方展开）
With ListBox1
.Top = Target.Top + Target.Height
.Left = Target.Left
.Width = Target.Width * 2
.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
第六步，点击左上角“文件”——》“保存”，然后再点击“运行”——》“运行子过程/用户窗体”，或直接按F5键(注意此时不会有任何提示运行成功的窗口出现)，关闭VB编辑器。
第七步，转到Sheet1表，双击C列下第二行(即刚才插入“列表框”所在的位置)，输入需要查询的内容，则下方文本框中将自动匹配所查询到的结果。
如此时点击“茶镜(㎡)”，则显示结果如下：
“序号”列填写公式：=IF(C2<>"",ROW(A1),"")
“材料编码”列填写公式：=VLOOKUP(C2,IF({1,0},数据源!$B$2:$B$99999,数据源!$A$2:$A$99999),2,0)
“单位”列填写公式：=IFNA(VLOOKUP(C2,数据源!$B$2:$C$9999,2,FALSE),"")
如所输入的内容不存在，则如下图显示
需要对来源表格或者取数据列等进行变更的，修改源代码中的如下三个字段内容即可。
Const DATA_SHEET As String = "数据源" ' 数据源工作表（即所要查询数据所在的工作表）
Const DATA_COL As String = "B" ' 数据源所在列（即所要进行模糊查找数据所在的列）
Const TARGET_COL As Integer = 3 ' 目标列（即Sheet1表中要显示并返回查询结果的列，A列为1）