Excel VBA实现渐进式模糊搜索

Excel在录入时可以匹配现有的内容，但有时还是满足不了我们的要求，以下是用Excel VBA实现的渐进式模糊搜索
作者：Excel小子-Office中国
实现的效果：

1480863417286548.jpg

Excel 模糊 渐进式搜索操作动画教程

1480863465173202.gif

Excel VBA实现渐进式模糊搜索的主要代码：
先放置 一个TextBox1 文本框 及列表框ListBox1
然后在工作表代码中
Dim dDim arr, brr(0)Dim ar
Private Sub ListBox1_Click()
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveCell = Me.ListBox1.ValueMe.ListBox1.Visible = FalseMe.TextBox1.Visible = FalseActiveCell.SelectEnd Sub
Private Sub ListBox1_GotFocus()
End SubPrivate Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)If KeyCode = 13 ThenActiveCell = ListBox1.ValueMe.ListBox1.Visible = FalseMe.TextBox1.Visible = FalseActiveCell.SelectEnd IfEnd 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  -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 IfEnd Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)On Error Resume NextIf 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 IfEnd Sub