伊之密压铸机工艺参数:仿Google输入框——快速查找列表框中的项目

Option ExplicitDim varData Private Sub txtFind_Change()Dim i As LongDim strFind As String strFind = "*" & UCase(Me.txtFind.Text) & "*" With Me.lbxData.List = varDataFor i = .ListCount - 1 To 0 Step -1If Not UCase(.List(i)) Like strFind Then.RemoveItem iEnd IfNext iEnd WithEnd Sub Private Sub UserForm_Initialize()Dim lLast As LongDim rng As Range lLast = Sheet1.Range("A" & Cells.Rows.Count).End(xlUp).RowvarData = Sheet1.Range("A1:A" & lLast) Me.lbxData.List = varDataEnd Sub

我们可以将UserForm_Initialize代码块中的代码Me.lbxData.List = varData删除，这样当在文本框txtFind中输入时，只要输入的数据符合列表框包含的数据，列表框中将自动出现相关条目并随着输入的进一步具体条目相应减少至完全匹配输入的数据，如图3、4、5所示。

图3：初始化后的用户窗体

图4：开始输入后，列表框中的条目随着文本框中输入的数据而变化

图5：文本框中的数据越具体，列表框中的条目也越少且与文本框输入相匹配
在Excel 2000及以后的版本中，VBA提供了一个Filter函数，使用该函数，也能实现上述效果，并且代码更简单。代码如下：

Option ExplicitPrivate Sub txtFind_Change()Dim varData As Variant varData = Range("A1", Cells(Rows.Count, 1).End(xlUp)).ValuevarData = Application.Transpose(varData) varData = Filter(SourceArray:=varData, _Match:=txtFind.Value, _Include:=True, _Compare:=vbTextCompare) Me.lbxData.List = varData End Sub Private Sub UserForm_Initialize() Me.lbxData.List = Range("A1", Cells(Rows.Count, 1).End(xlUp)).ValueEnd Sub

如果需要将列表框中所选择的条目放到文本框中，那么添加下面的代码：

Private Sub lbxData_Click()Me.txtFind.Value = Me.lbxData.ValueEnd Sub

示例文档下载：
在使用Google搜索时，一般我们会在输入框中输入想要搜索的文本，此时下方会出现相关条目供选择，以方便快速输入。下面，我们在Excel用户窗体中使用文本框和列表框来仿造这样的效果。
有时，当用户窗体中的列表框包含大量的项目时，我们必须拖动其滚动条来查找相应的项目。此时，可以利用一些技巧快速找到所需的项目。
如图1所示，在用户窗体中，放置有两个控件，上方是一个名为txtFind的文本框，下方是一个名为lbxData的列表框，列表框的数据来自工作表Data的列A中的数据。

图1：带有文本框和列表框的用户窗体，列表框中的数据来自Data工作表中的A列
当我在上方的文本框txtFind中输入“excel vba”后，下方的列表框lbxData中将会只出现包含有“excel vba”的条目，如图2所示。

图2：在文本框中输入文本后，列表框中只出现包含该文本的条目
实现上述效果的VBA代码如下：

Option ExplicitDim varData Private Sub txtFind_Change()Dim i As LongDim strFind As String strFind = "*" & UCase(Me.txtFind.Text) & "*" With Me.lbxData.List = varDataFor i = .ListCount - 1 To 0 Step -1If Not UCase(.List(i)) Like strFind Then.RemoveItem iEnd IfNext iEnd WithEnd Sub Private Sub UserForm_Initialize()Dim lLast As LongDim rng As Range lLast = Sheet1.Range("A" & Cells.Rows.Count).End(xlUp).RowvarData = Sheet1.Range("A1:A" & lLast) Me.lbxData.List = varDataEnd Sub

我们可以将UserForm_Initialize代码块中的代码Me.lbxData.List = varData删除，这样当在文本框txtFind中输入时，只要输入的数据符合列表框包含的数据，列表框中将自动出现相关条目并随着输入的进一步具体条目相应减少至完全匹配输入的数据，如图3、4、5所示。

图3：初始化后的用户窗体

图4：开始输入后，列表框中的条目随着文本框中输入的数据而变化

图5：文本框中的数据越具体，列表框中的条目也越少且与文本框输入相匹配
在Excel 2000及以后的版本中，VBA提供了一个Filter函数，使用该函数，也能实现上述效果，并且代码更简单。代码如下：

Option ExplicitPrivate Sub txtFind_Change()Dim varData As Variant varData = Range("A1", Cells(Rows.Count, 1).End(xlUp)).ValuevarData = Application.Transpose(varData) varData = Filter(SourceArray:=varData, _Match:=txtFind.Value, _Include:=True, _Compare:=vbTextCompare) Me.lbxData.List = varData End Sub Private Sub UserForm_Initialize() Me.lbxData.List = Range("A1", Cells(Rows.Count, 1).End(xlUp)).ValueEnd Sub

如果需要将列表框中所选择的条目放到文本框中，那么添加下面的代码：

Private Sub lbxData_Click()Me.txtFind.Value = Me.lbxData.ValueEnd Sub

示例文档下载：