无需激活Sheet1的VBA表单搜索及数据回填需求

一、修改原搜索代码（满足无激活Sheet1、多关键词搜索、保留当前工作表） #

原代码依赖激活Sheet1和选中操作，我们通过直接指定工作表对象避免切换工作表，同时加入多关键词拆分逻辑，修改后代码如下：

Private Sub txtTarget_Change() ' 假设原触发事件为文本框内容变更，可根据实际调整
    Dim searchText As String, keywords() As String
    Dim FirstAddr As String, keyword As Variant
    Dim FoundCell As Range, LastCell As Range, searchRange As Range
    Dim i As Integer, endRow As Long, j As Integer
    Dim foundTarget As Boolean, isDuplicate As Boolean
    
    searchText = Trim(Me.txtTarget.Text)
    If Len(searchText) = 0 Then
        Me.lstCustSearch.Clear
        Exit Sub
    End If
    
    ' 按空格拆分多关键词，支持多个关键词同时搜索
    keywords = Split(searchText, " ")
    
    Application.ScreenUpdating = False
    
    ' 直接操作Sheet1数据，无需激活/选中
    With Sheet1
        endRow = .Range("A1").End(xlDown).Row
        Set searchRange = .Range("A2:D" & endRow)
    End With
    
    Me.lstCustSearch.Clear
    foundTarget = False
    i = 0
    
    With searchRange
        Set LastCell = .Cells(.Cells.Count)
        
        ' 遍历每个关键词执行搜索
        For Each keyword In keywords
            If Len(Trim(keyword)) > 0 Then ' 跳过连续空格产生的空关键词
                Set FoundCell = .Find(what:=keyword, after:=LastCell, LookIn:=xlValues, LookAt:=xlPart)
                
                If Not FoundCell Is Nothing Then
                    FirstAddr = FoundCell.Address
                    foundTarget = True
                    
                    Do
                        ' 避免同一行因匹配多个关键词重复添加
                        isDuplicate = False
                        For j = 0 To Me.lstCustSearch.ListCount - 1
                            If Me.lstCustSearch.List(j, 0) = Sheet1.Cells(FoundCell.Row, 1).Value Then
                                isDuplicate = True
                                Exit For
                            End If
                        Next j
                        
                        If Not isDuplicate Then
                            Me.lstCustSearch.AddItem Sheet1.Cells(FoundCell.Row, 1).Value
                            Me.lstCustSearch.List(i, 1) = Sheet1.Cells(FoundCell.Row, 2).Value
                            Me.lstCustSearch.List(i, 2) = Sheet1.Cells(FoundCell.Row, 3).Value
                            Me.lstCustSearch.List(i, 3) = Format(Sheet1.Cells(FoundCell.Row, 4).Value, "$#,##0.00")
                            i = i + 1
                        End If
                        
                        Set FoundCell = .FindNext(after:=FoundCell)
                    Loop While Not FoundCell Is Nothing And FoundCell.Address <> FirstAddr
                End If
            End If
        Next keyword
    End With
    
    If Not foundTarget Then
        MsgBox "未找到匹配 '" & searchText & "' 的数据"
    Else
        Me.txtTarget.Text = ""
    End If
    
    Me.txtTarget.SetFocus
    Application.ScreenUpdating = True
End Sub

修改核心点： #

• 移除Sheet1.Activate和所有Select操作，所有单元格引用明确绑定Sheet1对象，全程无需切换工作表
• 加入多关键词拆分逻辑，支持空格分隔的多个关键词同时搜索
• 添加重复行判断，避免同一数据行因匹配多个关键词被重复添加到列表框
• 优化Find方法参数，指定LookIn:=xlValues和LookAt:=xlPart实现模糊匹配，如需精确匹配可改为xlWhole

二、添加数据回填命令按钮 #

1. 在用户表单中添加一个命令按钮（命名为cmdFillBack，标题设为"回填选中数据"）
2. 双击按钮添加以下代码：

Private Sub cmdFillBack_Click()
    Dim selectedRow As Integer
    Dim targetRange As Range
    
    ' 检查是否选中列表项
    If Me.lstCustSearch.ListIndex = -1 Then
        MsgBox "请先选择要回填的数据"
        Exit Sub
    End If
    
    ' 以当前工作表的活动单元格作为回填起始位置
    Set targetRange = ActiveCell
    
    ' 回填选中的4列数据到当前工作表
    With Me.lstCustSearch
        selectedRow = .ListIndex
        targetRange.Value = .List(selectedRow, 0)
        targetRange.Offset(0, 1).Value = .List(selectedRow, 1)
        targetRange.Offset(0, 2).Value = .List(selectedRow, 2)
        targetRange.Offset(0, 3).Value = .List(selectedRow, 3)
    End With
    
    ' 如需回填后自动关闭表单，取消下方注释
    ' Unload Me
End Sub

功能说明： #

• 点击按钮后，将列表框选中的一行数据，回填到当前工作表的活动单元格开始的连续4列中
• 自动校验选中状态，避免空操作报错
• 全程保持在当前工作表，无需切换目标表

内容的提问来源于stack exchange，提问作者mdashed