Excel在录入时可以匹配现有的内容，但有时还是满足不了我们的要求，以下是用Excel VBA实现的渐进式模糊搜索
作者：Excel小子-Office中国
实现的效果：
Excel 模糊 渐进式搜索操作动画教程
Excel VBA实现渐进式模糊搜索的主要代码：
先放置 一个TextBox1 文本框 及列表框ListBox1
然后在工作表代码中
Dim d
Dim arr, brr(0)
Dim ar
Private Sub ListBox1_Click()
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
ActiveCell = Me.ListBox1.Value
Me.ListBox1.Visible = False
Me.TextBox1.Visible = False
ActiveCell.Select
End Sub
Private Sub ListBox1_GotFocus()
End Sub
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Then
ActiveCell = ListBox1.Value
Me.ListBox1.Visible = False
Me.TextBox1.Visible = False
ActiveCell.Select
End If
End Sub
Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If WorksheetFunction.CountA(ActiveSheet.UsedRange) > 0 Then
If WorksheetFunction.CountA(ActiveSheet.UsedRange) = 1 Then
brr(0) = ActiveSheet.UsedRange
arr = brr
Else
arr = ActiveSheet.UsedRange
End If
Dim ct
Set d = CreateObject("scripting.dictionary")
If KeyCode = vbKeyDown Then
'Stop
ct = ListBox1.ListIndex + 1
If ct < ListBox1.ListCount Then ListBox1.ListIndex = ct Else ListBox1.ListIndex = 0
ElseIf KeyCode = vbKeyUp Then
ct = ListBox1.ListIndex - 1
If ct > -1 Then ListBox1.ListIndex = ct Else ListBox1.ListIndex = ListBox1.ListCount - 1
End If
If KeyCode <> 37 And KeyCode <> 39 And KeyCode <> 13 Then
For Each ar In arr
If Len(ar) > 0 Then
If InStr(ar, TextBox1.Value) = 1 Then
d(ar) = ""
End If
End If
Next ar
End If
If d.Count > 0 And Len(Me.TextBox1.Value) > 0 Then
With Me.ListBox1
.Visible = True
.Left = ActiveCell.Left + ActiveCell.Width
.Top = ActiveCell.Top
.Height = ActiveCell.Height * 5
.Width = ActiveCell.Width * 2
.List = d.keys
End With
Else
Me.ListBox1.Visible = False
End If
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Target.Count = 1 Then
Me.ListBox1.Visible = False
With Me.TextBox1
.Value = ""
.Visible = True
.Activate
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width
.Height = Target.Height
End With
End If
End Sub
