EXCEL跨文件查询，指定条件列，返回满足条件的指定列

EXCEL跨文件查询，指定条件列，返回满足条件的指定列

Private Sub cmd_find_from_workbooks_Click()
Dim S_Cols As String, thePath As String, Sor_Col As Integer, sz_Cols As Variant
S_Cols = T_jieguo_cols.Text
sz_Cols = Split(S_Cols, ",")
thePath = T_path.Text
Sor_Col = T_Search_Col_No.Text
InsertColumnToRightByIndex T_Search_Col_No.Text, UBound(sz_Cols) + 1 '右侧插入列

Sub_FindFromWorkbooks Sor_Col, T_Search_ROW_Str.Text, thePath, S_Cols

End Sub
 Sub Sub_FindFromWorkbooks(ByVal Sor_Col As Integer, ByVal str_ROW As Integer, ByVal mubiao_Path As String, ByVal return_Cols As String)
 '跨文件查询数据
    Dim SourceWorkbook As Workbook
    Dim TargetWorkbook As Workbook
    Dim SourceSheet As Worksheet
    Dim TargetSheets As Object, TargetSheet As Object

    Dim FoundRange As Range
    Dim SearchValue As String, SearchPath As String
    Dim rng As Range
    Dim cell As Range
    Dim last_Row_No As Long
    Dim sz_Cols As Variant
    Dim i%, j%, i_s$

    ' 设置源工作簿和工作表
    Set SourceWorkbook = ThisWorkbook ' 当前打开的工作簿
    Set SourceSheet = SourceWorkbook.ActiveSheet ' 源工作表

    ' 设置目标工作簿和工作表
    'SearchPath = "F:\F\20240529-贝达项目\001-清单\001-02-弱电清单\搜索网线标签.xls"
    SearchPath = mubiao_Path
    Set TargetWorkbook = Workbooks.Open(SearchPath)
    last_Row_No = SourceSheet.UsedRange.Rows.Count + SourceSheet.UsedRange.Row - 1 '最后一行
    sz_Cols = Split(return_Cols, ",")

    For i = str_ROW To last_Row_No

        i_s = SourceSheet.Cells(i, Sor_Col).Value

        ' 设置要搜索的值
        SearchValue = 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

                    For j = LBound(sz_Cols) To UBound(sz_Cols)
                    '输出sheet名称，和所需要的列的内容。
                        Select Case j
                        Case Is = 0
                        SourceSheet.Cells(i, Sor_Col + j + 1).Value = TargetSheet.Name & "--" & cell.Row - 1
                        Case Else
                        SourceSheet.Cells(i, Sor_Col + j + 1).Value = cell.Value
                        End Select
                    Next j
                    Exit For ' 可选：如果只需要找到第一个匹配项
                End If
            Next cell
        Next TargetSheet

    Next i
    ' 关闭目标工作簿（可选）
    TargetWorkbook.Close SaveChanges:=False
End Sub

Sub GetLastRowUsedRange()
'获得有效行数
    Dim ws As Worksheet
    Set ws = ThisWorkbook.ActiveSheet
    
    Dim lastRowUsedRange As Long
    lastRowUsedRange = ws.UsedRange.Rows.Count + ws.UsedRange.Row - 1 ' UsedRange的Row属性给出的是范围的第一行的行号
    
    MsgBox "The last row with data in the used range is: " & lastRowUsedRange
End Sub