针对你需要在不打开源文件Formini1.xlsm的情况下，让Tampil1.xlsm实现高级筛选搜索的需求，我整理了三个实用的解决方案，都是实际项目中验证过的：

方案1：用ADO直接读取关闭的Excel文件（推荐） #

这是处理这类需求的标准做法，通过ADO（ActiveX Data Objects）直接连接并读取关闭的Excel文件，完全不需要打开源文件，性能稳定且效率高，还支持复杂的SQL查询。

代码示例（按钮点击事件） #

Private Sub cmdSearch_Click()
    Dim conn As Object
    Dim rs As Object
    Dim strSQL As String
    Dim strConn As String
    Dim sourcePath As String
    Dim keyword As String
    
    ' 获取输入的关键词（假设输入框是TextBox1）
    keyword = Trim(Me.TextBox1.Value)
    If keyword = "" Then
        MsgBox "请输入搜索关键词！", vbExclamation
        Exit Sub
    End If
    
    ' 源文件路径（假设和目标文件在同一文件夹）
    sourcePath = ThisWorkbook.Path & "\Formini1.xlsm"
    
    ' 检查源文件是否存在
    If Dir(sourcePath) = "" Then
        MsgBox "源文件未找到，请检查路径！", vbCritical
        Exit Sub
    End If
    
    ' 创建ADO连接和记录集对象
    Set conn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    
    ' 适配Excel 2007+的连接字符串
    strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
              "Data Source=" & sourcePath & ";" & _
              "Extended Properties=""Excel 12.0 Macro;HDR=YES;"";"
    
    ' 构建模糊搜索的SQL语句（替换【你的字段名】为实际列名，Sheet1替换为源数据工作表名）
    strSQL = "SELECT * FROM [Sheet1$] WHERE 你的字段名 LIKE '%" & keyword & "%'"
    
    On Error GoTo ErrorHandler
    ' 执行查询
    conn.Open strConn
    rs.Open strSQL, conn
    
    ' 清空目标工作表并写入结果（假设结果显示在Sheet2）
    ThisWorkbook.Sheets("Sheet2").UsedRange.Clear
    ThisWorkbook.Sheets("Sheet2").Range("A1").CopyFromRecordset rs
    
    MsgBox "搜索完成！", vbInformation

Cleanup:
    ' 释放资源
    If Not rs Is Nothing Then rs.Close
    If Not conn Is Nothing Then conn.Close
    Set rs = Nothing
    Set conn = Nothing
    Exit Sub

ErrorHandler:
    MsgBox "搜索出错：" & Err.Description, vbCritical
    GoTo Cleanup
End Sub

适用场景 #

• 需要实时获取源文件最新数据
• 支持多条件复杂查询
• 不希望干扰源文件的正常使用

方案2：临时打开源文件，读取后立即关闭 #

如果你更习惯使用Excel内置的高级筛选功能，可以临时以只读模式打开源文件，完成数据筛选后立即关闭，用户几乎看不到文件打开的过程。

代码示例（按钮点击事件） #

Private Sub cmdSearch_Click()
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim keyword As String
    Dim sourcePath As String
    
    keyword = Trim(Me.TextBox1.Value)
    If keyword = "" Then
        MsgBox "请输入搜索关键词！", vbExclamation
        Exit Sub
    End If
    
    sourcePath = ThisWorkbook.Path & "\Formini1.xlsm"
    If Dir(sourcePath) = "" Then
        MsgBox "源文件未找到！", vbCritical
        Exit Sub
    End If
    
    ' 关闭屏幕刷新和警告，避免闪屏
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    On Error GoTo ErrorHandler
    
    ' 以只读模式打开源文件（不会锁定源文件）
    Set wbSource = Workbooks.Open(Filename:=sourcePath, ReadOnly:=True)
    Set wsSource = wbSource.Sheets("Sheet1") ' 源数据工作表
    Set wsTarget = ThisWorkbook.Sheets("Sheet2") ' 结果显示工作表
    
    ' 清空目标表
    wsTarget.UsedRange.Clear
    
    ' 设置高级筛选条件区域（D1为字段名，D2为关键词）
    wsTarget.Range("D1").Value = "你的字段名"
    wsTarget.Range("D2").Value = "*" & keyword & "*"
    
    ' 执行高级筛选
    wsSource.Range("A1").CurrentRegion.AdvancedFilter _
        Action:=xlFilterCopy, _
        CriteriaRange:=wsTarget.Range("D1:D2"), _
        CopyToRange:=wsTarget.Range("A1"), _
        Unique:=False
    
    ' 清理条件区域
    wsTarget.Range("D1:D2").Clear
    
    MsgBox "搜索完成！", vbInformation

Cleanup:
    ' 关闭源文件，不保存任何修改
    If Not wbSource Is Nothing Then wbSource.Close SaveChanges:=False
    ' 恢复Excel设置
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Set wsSource = Nothing
    Set wsTarget = Nothing
    Set wbSource = Nothing
    Exit Sub

ErrorHandler:
    MsgBox "出错：" & Err.Description, vbCritical
    GoTo Cleanup
End Sub

适用场景 #

• 依赖Excel内置的高级筛选功能
• 源文件数据结构复杂，需要保留Excel的格式或公式

方案3：预加载源数据到隐藏工作表（适合非实时场景） #

如果源文件数据更新频率不高，可以定期将源数据导入到目标文件的隐藏工作表中，之后搜索直接使用隐藏表的数据，完全不需要再访问源文件。

代码示例（分为刷新数据和搜索两个按钮） #

1. 刷新数据按钮（定期执行）

Private Sub cmdRefreshData_Click()
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
    Dim wsHidden As Worksheet
    Dim sourcePath As String
    
    sourcePath = ThisWorkbook.Path & "\Formini1.xlsm"
    If Dir(sourcePath) = "" Then
        MsgBox "源文件未找到！", vbCritical
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    On Error GoTo ErrorHandler
    
    Set wbSource = Workbooks.Open(Filename:=sourcePath, ReadOnly:=True)
    Set wsSource = wbSource.Sheets("Sheet1")
    
    ' 检查是否存在隐藏数据表，不存在则新建
    On Error Resume Next
    Set wsHidden = ThisWorkbook.Sheets("HiddenData")
    On Error GoTo ErrorHandler
    If wsHidden Is Nothing Then
        Set wsHidden = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        wsHidden.Name = "HiddenData"
        wsHidden.Visible = xlSheetVeryHidden ' 完全隐藏，用户无法通过右键显示
    End If
    
    ' 复制源数据到隐藏表
    wsHidden.UsedRange.Clear
    wsSource.Range("A1").CurrentRegion.Copy wsHidden.Range("A1")
    
    MsgBox "数据刷新完成！", vbInformation

Cleanup:
    wbSource.Close SaveChanges:=False
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Set wsSource = Nothing
    Set wsHidden = Nothing
    Set wbSource = Nothing
    Exit Sub

ErrorHandler:
    MsgBox "刷新出错：" & Err.Description, vbCritical
    GoTo Cleanup
End Sub

2. 搜索按钮（使用隐藏表数据）

Private Sub cmdSearch_Click()
    Dim keyword As String
    Dim wsHidden As Worksheet
    Dim wsTarget As Worksheet
    
    keyword = Trim(Me.TextBox1.Value)
    If keyword = "" Then
        MsgBox "请输入搜索关键词！", vbExclamation
        Exit Sub
    End If
    
    On Error Resume Next
    Set wsHidden = ThisWorkbook.Sheets("HiddenData")
    On Error GoTo ErrorHandler
    If wsHidden Is Nothing Then
        MsgBox "请先点击【刷新数据】按钮！", vbExclamation
        Exit Sub
    End If
    
    Set wsTarget = ThisWorkbook.Sheets("Sheet2")
    wsTarget.UsedRange.Clear
    
    ' 执行高级筛选
    wsTarget.Range("D1").Value = "你的字段名"
    wsTarget.Range("D2").Value = "*" & keyword & "*"
    
    wsHidden.Range("A1").CurrentRegion.AdvancedFilter _
        Action:=xlFilterCopy, _
        CriteriaRange:=wsTarget.Range("D1:D2"), _
        CopyToRange:=wsTarget.Range("A1"), _
        Unique:=False
    
    wsTarget.Range("D1:D2").Clear
    MsgBox "搜索完成！", vbInformation

Cleanup:
    Set wsHidden = Nothing
    Set wsTarget = Nothing
    Exit Sub

ErrorHandler:
    MsgBox "搜索出错：" & Err.Description, vbCritical
    GoTo Cleanup
End Sub

适用场景 #

• 源文件数据更新频率低（如每日/每周更新）
• 需要极致的搜索速度
• 源文件可能被频繁移动或暂时不可用

内容的提问来源于stack exchange，提问作者Jaka E Sembodo