输入时自动筛选符合条件的条目(渐进式搜索)

晚上闲逛EXCEL的VBA时,发现一个叫filter的函数很不错,自己以前写的一大堆代码,用这个函数替代的话,简洁非常之多,特写一段示例,,与大家分享一下。

很多财会或文员，经常会输入产品名称或客户名称等要求一字不差的项目，此时如果像google一样可以渐近式搜索并列出符合条件的条目，则会使工作轻松不少。本例并不是完整的实现代码，但稍加更改就可以用到实际工作中。

 

 

'以下是代码--------------------------------------------------------------------------

'功能:
'    在文本框输入筛选的条件 , 下方的列表框将自动列出符合条件的条目
'说明:
'    1.因为是示列,条目的来源固定为一个纵向的单元格区域(命名为"VS")
'    2.按每个词筛选,且不分词的位置前后,各词之间以空格或*号分隔
'    3.未对初始状态作处理,所以初始列表为空白
'    4.要测试本代码,请新建一个工作薄,在sheet1上的某列上输入条目,并将该区域命为"VS"
'    并添加文本框"textbox1"及列表框"listbox1",然后将代码粘贴到sheet1的代码窗口

 

Private Sub TextBox1_Change()
OnChange TextBox1.Text
End Sub

Private Sub OnChange(ByVal cCondition As String)
On Error GoTo errh:
Dim SourceData As Variant   '条目来源
Dim Condition As String     '筛选条件
Dim conditions() As String  '存放分拆成词后的条件数组
Dim sCondi As Variant       '用于在条件数组中循环

SourceData = Sheet1.Range("vs")
SourceData = Application.Transpose(SourceData)  '因为是纵向的单元格区域 所以旋转一下

Condition = cCondition
If Len(Condition) > 128 Then Condition = Left(Condition, 128)       '限制一下长度,避免出现溢出,虽然我还没试过
Condition = Replace(Condition, " ", "*")        '将条件稍做处理
conditions = Split(Condition, "*")

For Each sCondi In conditions
 SourceData = Filter(SourceData, sCondi, True, vbTextCompare)   '按词对条目进行多次筛选过滤
Next sCondi

 
ListBox1.List = SourceData  '赋值给列表框
Exit Sub

'如果不幸发生错误,以下语句会让我们痛个明白
errh:
MsgBox Err.Description
End Sub

'代码结束------------------------------------------------------------------------

 

附件地址(下载后把.JPG去掉):

https://p-blog.csdn.net/images/p_blog_csdn_net/bluewinding/EntryImages/20090720/FilterList.xls.jpg

 

工作表显示如下