标签：VBA,用户窗体,列表框
有时候，我们想从数据表中搜索指定的内容，但匹配项往往不只一项，而我们想要将匹配项全部显示出来，如下图1所示。
图1
在Excel中，有很多方法可以实现，这里使用用户窗体和VBA代码来完成。
示例数据如下图2所示。
图2
单击“查找”按钮，弹出我们所设计的用户窗体如下图3所示。
图3
其中，最主要的“查找”按钮对应的代码如下：
代码语言：javascript复制Private Sub SearchBtn_Click()
Dim SearchTerm As String
Dim SearchColumn As String
Dim RecordRange As Range
Dim FirstAddress As String
Dim FirstCell As Range
Dim RowCount As Integer
' 如果没有数据项输入则显示错误
If FName.Value = "" AndLName.Value = "" And Location.Value = "" AndDepartment.Value = "" Then
MsgBox "没有指定搜索项", vbCritical vbOKOnly
Exit Sub
End If
' 找出要搜索的内容
If FName.Value <> "" Then
SearchTerm = FName.Value
SearchColumn = "姓名"
End If
If LName.Value <> "" Then
SearchTerm = LName.Value
SearchColumn = "性别"
End If
If Location.Value <> ""Then
SearchTerm = Location.Value
SearchColumn = "城市"
End If
If Department.Value <> ""Then
SearchTerm = Department.Value
SearchColumn = "部门"
End If
Results.Clear
' 仅在相关表格列中搜索，即如果某人正在搜索位置，则仅在位置列中搜索
With Range("Table1[" &SearchColumn & "]")
' 查找第一个匹配项
Set RecordRange = .Find(SearchTerm,LookIn:=xlValues)
' 如果已找到匹配项
If Not RecordRange Is Nothing Then
FirstAddress = RecordRange.Address
RowCount = 0
Do
' 设置匹配值行中的第一个单元格
Set FirstCell =Range("A" & RecordRange.Row)
' 添加匹配记录到列表框
Results.AddItem
Results.List(RowCount, 0) =FirstCell(1, 1)
Results.List(RowCount, 1) = FirstCell(1,2)
Results.List(RowCount, 2) =FirstCell(1, 3)
Results.List(RowCount, 3) =FirstCell(1, 4)
RowCount = RowCount 1
' 查找下一个匹配项
Set RecordRange =.FindNext(RecordRange)
' 当不再找得到匹配项时, 退出过程
If RecordRange Is Nothing Then
Exit Sub
End If
' 在找到唯一匹配项时继续查找
Loop While RecordRange.Address<> FirstAddress
Else
' 如果到了这里，则没有找到匹配的
Results.AddItem
Results.List(RowCount, 0) = "没有找到"
End If
End With
End Sub代码中的Table1就是工作表中表名。
