Excel VBA 动态搜索&(双击选中|键盘选中listbox内容)&单个单元格局部文字高亮

1.单个单元格局部文字高亮

新建模块，输入代码，开发工具插入按键，赋予DemoHighLightChar()函数。

Sub DemoHighLightChar()
    Dim KeyWords As String
    Dim i As Integer
    Dim C As Range
    Dim ComRng As Range
    Dim FirstAddress As String
     
    KeyWords = InputBox("输入查找关键字", "提示")
If Not KeyWords = "" Then
    With ActiveSheet.UsedRange
        Set C = .Find(what:=KeyWords, lookat:=xlPart)
        If Not C Is Nothing Then
            FirstAddress = C.Address
            Do
                With C
                    .Font.ColorIndex = xlAutomatic
                    .Characters(Start:=InStr(1, C, KeyWords), Length:=Len(KeyWords)).Font.Color = vbGreen
                End With
                Set C = .FindNext(C)
            Loop While Not C Is Nothing And C.Address <> FirstAddress
        Else
            MsgBox "没找到相关内容", vbExclamation, "提示"
        End If
    End With
End If
End Sub

2.动态搜索

在所在Sheet中使用 开发工具 ->插入 ActiveX控件 中的textbox和listbox

工作表选取改变事件，选取工作表的特定的位置（代码中规定），弹出textbox和listbox。

'工作表选取改变事件
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim i, x, rownu As Variant
    Dim d As Object
    Dim arr, arr_key, arr1, yun, arr_po
    Dim website_name As String
    
    Set d = CreateObject("scripting.dictionary")
    Me.ListBox1.Clear
    'target为选取的单元格对象
    tacolumn = Target.Column
    tarow = Target.Row
  
    '添加website部分
    '选择触发的区域，使用Target.Cells.CountLarge是为了保证选择的是一个单元格而不是一片区域，同时区域过大不会报错
        If Target.Column = 22 And Target.Cells.CountLarge = 1 Then
            With Me.TextBox1 'textbox的大小，位置，和显示
                .Visible = True
                .Top = Target.Top
                .Left = Target.Left
                .Width = Target.Width
                .Height = Target.Height
                .Activate
            End With
            With Me.ListBox1 'listbox的大小，位置，和显示
                .Visible = True
                .Top = Target.Top
                .Left = Target.Left + Target.Width
                .Width = 300
                .Height = 300
                '将需要写入的数据装入数组
                arr = Sheets("Sheet2").Range("e2:e" & Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row)
                For x = 1 To UBound(arr)
                d(arr(x, 1)) = ""
                Next
                '将值写入到listbox中
                .List = d.keys()
                
            End With
        Else
            Me.ListBox1.Clear
            Me.TextBox1 = ""
            Me.ListBox1.Visible = False
            Me.TextBox1.Visible = False
        End If
End Sub

textbox键盘抬起事件：输入文字后进行动态查询代码中所规定的库（Sheet2中的内容），其中要注意KeyCode的值，13是回车（使用MsgBox试出来的）。

'textbox键盘抬起事件：即输入了文字
Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Dim i, x As Integer
    Dim Language As Boolean, arr1 As Variant
    Dim myStr As String, str_B As String
    Dim d As Object
    Dim arr, arr_key
    
    Set d = CreateObject("scripting.dictionary")
    Me.ListBox1.Clear
    myStr = Me.TextBox1.Value
    With Me.ListBox1
                .Width = 400
                .Height = 300
    End With
    If tacolumn = 22 Then
    With Sheets("Sheet2")
           
                arr1 = .Range("e2:e" & .Range("a65535").End(xlUp).Row)
                For i = 1 To .Range("a65535").End(xlUp).Row - 1
                '利用instr遍历找到包含输入文字的部分,并 赋值到字典里避免重复
                   If InStr(1, arr1(i, 1), myStr, 1) Then
                       d(arr1(i, 1)) = ""
                   End If
                Next i
                Me.ListBox1.List = d.keys() 'listbox赋值
            
    End With
    If KeyCode = 13 Then
    Me.ListBox1.Activate
    End If
    End If
End Sub

3.双击选中|键盘选中listbox内容

双击listbox选中内容。

'listbox双击事件
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim arr
    If tacolumn = 22 Then
    '将listbox值赋予当前单元格
        ActiveCell.Value = Me.ListBox1.Value
        Me.ListBox1.Clear
        Me.TextBox1 = "" '清空listbox与textbox
        Me.ListBox1.Visible = False 'y隐藏textbox和listbox
        Me.TextBox1.Visible = False

    End If
End Sub

键盘选中listbox内容，需要上下键高亮文本后再空格选中。

'listbox回车事件
Private Sub ListBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If tacolumn = 22 And KeyCode = 32 Then
        '将listbox值赋予当前单元格
        Cells(tarow, tacolumn).Value = Me.ListBox1.Value
        Me.ListBox1.Clear
        Me.TextBox1 = "" '清空listbox与textbox
        Me.ListBox1.Visible = False 'y隐藏textbox和listbox
        Me.TextBox1.Visible = False

    End If
End Sub