Dim Rng As Range
Dim Arr As Variant
Dim LastCell As Range
Dim FindText As String
Dim ItemCount As Long
Dim Dic As Object
Private Sub CbOption_Change()
    FindText = CbOption.Text
    If Len(FindText) > 0 Then
        If Dic.Exists(FindText) = False Then
            Call FilterItems
        End If
    End If
End Sub
Private Sub CbOption_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Application.EnableEvents = False
    If KeyCode = 13 Then
        LastCell.Value = http://www.mamicode.com/CbOption.Text""
            Call AddItems
        End If
    Else
        Me.CbOption.Clear
        Me.CbOption.Visible = False
    End If
    Application.EnableEvents = True
End Sub
Private Sub AddItems()
    Me.CbOption.Clear
    Set Dic = CreateObject("Scripting.Dictionary")
    Set Rng = Application.ThisWorkbook.Worksheets("选项").Range("A1:A117")
    Arr = Rng.Value
    For i = LBound(Arr) To UBound(Arr)
        Key = CStr(Arr(i, 1))
        Dic(Key) = ""
        Me.CbOption.AddItem Key
    Next i
End Sub
Private Sub FilterItems()
    ItemCount = Me.CbOption.ListCount - 1
    Set Rng = Application.ThisWorkbook.Worksheets("选项").Range("A1:A117")
    Arr = Rng.Value
    For i = LBound(Arr) To UBound(Arr)
        Key = CStr(Arr(i, 1))
        If Key Like "*" & FindText & "*" Then
            Me.CbOption.AddItem Key
        End If
    Next i
    For i = ItemCount To 0 Step -1
        Me.CbOption.RemoveItem (i)
    Next i
End Sub