EXCEL超级查询，从一个工作簿查找另一个工作簿的所有表，并返回符合条件的单元格

EXCEL超级查询，从一个工作簿查找另一个工作簿的所有表，并返回符合条件的单元格

Private Sub fun_findstring_Click()
    Dim SourceWorkbook As Workbook
    Dim TargetWorkbook As Workbook
    Dim SourceSheet As Worksheet
    Dim TargetSheet As Worksheet
    
    Dim FoundRange As Range
    Dim SearchValue As String, SearchPath As String
    Dim rng As Range
    Dim cell As Range
    
    ' 设置源工作簿和工作表
    Set SourceWorkbook = ThisWorkbook ' 当前打开的工作簿
    Set SourceSheet = SourceWorkbook.Sheets(ActiveSheet.Name) ' 源工作表
    
    ' 设置目标工作簿和工作表
    SearchPath = "F:\F\20240529-贝达项目\001-清单\001-02-弱电清单\搜索网线标签.xls"
    Set TargetWorkbook = Workbooks.Open(SearchPath)
    
    For i = 3 To 500
    
        i_S = SourceSheet.Cells(i, 5).Value
        
        ' 设置要搜索的值
        SearchValue = "F:" & i_S  ' 获取搜索值
        Set TargetSheets = TargetWorkbook.Worksheets
        
        ' 遍历目标工作簿中的所有工作表
        For Each TargetSheet In TargetSheets
            ' 遍历工作表中的所有单元格
            
            Set rng = TargetSheet.UsedRange
            For Each cell In rng
                If InStr(1, cell.Value, SearchValue, vbTextCompare) > 0 And InStr(1, TargetSheet.Name, "内容", vbTextCompare) > 0 Then
                    ' 如果找到了匹配项，则输出旁边的单元格值
                    'MsgBox "Found in " & TargetSheet.Name & ": " & cell.Offset(0, 1).Value
                    'MsgBox TargetSheet.Name
                    SourceSheet.Cells(i, 3).Value = TargetSheet.Name & "--" & cell.Row
                    SourceSheet.Cells(i, 4).Value = cell.Value
                    
                    Exit For ' 可选：如果只需要找到第一个匹配项
                End If
            Next cell
        Next TargetSheet
    
    Next i
    ' 关闭目标工作簿（可选）
    TargetWorkbook.Close SaveChanges:=False
End Sub