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