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_ColsEnd SubSub 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 WorkbookDim TargetWorkbook As WorkbookDim SourceSheet As WorksheetDim TargetSheets As Object, TargetSheet As ObjectDim FoundRange As RangeDim SearchValue As String, SearchPath As StringDim rng As RangeDim cell As RangeDim last_Row_No As LongDim sz_Cols As VariantDim i%, j%, i_s$' 设置源工作簿和工作表Set SourceWorkbook = ThisWorkbook ' 当前打开的工作簿Set SourceSheet = SourceWorkbook.ActiveSheet ' 源工作表' 设置目标工作簿和工作表'SearchPath = "F:\F\20240529-贝达项目\001-清单\001-02-弱电清单\搜索网线标签.xls"SearchPath = mubiao_PathSet 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_Noi_s = SourceSheet.Cells(i, Sor_Col).Value' 设置要搜索的值SearchValue = i_s   ' 获取搜索值Set TargetSheets = TargetWorkbook.Worksheets' 遍历目标工作簿中的所有工作表For Each TargetSheet In TargetSheets' 遍历工作表中的所有单元格Set rng = TargetSheet.UsedRangeFor Each cell In rngIf 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.NameFor j = LBound(sz_Cols) To UBound(sz_Cols)'输出sheet名称，和所需要的列的内容。Select Case jCase Is = 0SourceSheet.Cells(i, Sor_Col + j + 1).Value = TargetSheet.Name & "--" & cell.Row - 1Case ElseSourceSheet.Cells(i, Sor_Col + j + 1).Value = cell.ValueEnd SelectNext jExit For ' 可选：如果只需要找到第一个匹配项End IfNext cellNext TargetSheetNext i' 关闭目标工作簿（可选）TargetWorkbook.Close SaveChanges:=False
End SubSub GetLastRowUsedRange()
'获得有效行数Dim ws As WorksheetSet ws = ThisWorkbook.ActiveSheetDim lastRowUsedRange As LonglastRowUsedRange = ws.UsedRange.Rows.Count + ws.UsedRange.Row - 1 ' UsedRange的Row属性给出的是范围的第一行的行号MsgBox "The last row with data in the used range is: " & lastRowUsedRange
End Sub

VBA的其他方法，查询表中的某列，符号某列的值，返回其他列的值；

Sub ZhiJia()' 声明变量Dim ws As WorksheetDim wsSupport As WorksheetDim Col_Valve As IntegerDim Col_ZhiJia As IntegerDim Col_Result As IntegerDim STR_ROW As LongDim END_ROW As LongDim i As LongDim j As LongDim ZHIJIA_NAME As StringDim N As LongDim ALL_Rows As LongDim valve As StringDim valveData() As VariantDim supportCounts As ObjectDim key As VariantDim value As VariantDim result As StringDim firstItem As BooleanDim outputColumn As IntegerDim modelColumn As IntegerDim modelResult As StringDim firstModelItem As Boolean' 设置工作表（假设是当前活动的工作表）Set ws = ActiveSheetSet wsSupport = ThisWorkbook.Sheets("支架型号") ' 假设“支架型号”工作表名为“支架型号”' 定义阀门位号和支架编号所在的列号Col_Valve = 2 ' 第2列是所有阀门位号Col_ZhiJia = 6 ' 第6列是支架编号' 从用户输入获取阀门位号所在的列号COL_VALVE1 = InputBox("请输入需要被检索的阀门位号所在的列号:")outputColumn = COL_VALVE1 + 1 ' 输出结果的列号modelColumn = outputColumn + 1 ' 模型结果的列号' 获取开始和结束行数STR_ROW = 2 ' 开始行END_ROW = 1000 ' 结束行' 查找数据区域内的总行数ALL_Rows = ws.Cells(Rows.Count, Col_Valve).End(xlUp).Row' 创建一个字典来存储支架编号及其对应的计数Set supportCounts = CreateObject("Scripting.Dictionary")' 读取第2列的所有数据到一个数组中ReDim valveData(1 To ALL_Rows)For N = 1 To ALL_RowsvalveData(N) = ws.Cells(N, Col_Valve).valueNext N' 循环遍历指定范围内的每一行For i = STR_ROW To END_ROWvalve = ws.Cells(i, CInt(COL_VALVE1)).value' 检查阀门位号是否与给定的阀门匹配For N = 1 To ALL_RowsZHIJIA_NAME = ws.Cells(N, Col_ZhiJia).valueIf valveData(N) = valve And ZHIJIA_NAME <> "" Then' 更新字典中的计数If Not supportCounts.Exists(ZHIJIA_NAME) ThensupportCounts.Add ZHIJIA_NAME, 1ElsesupportCounts(ZHIJIA_NAME) = supportCounts(ZHIJIA_NAME) + 1End IfEnd IfNext N' 构建结果字符串result = ""firstItem = TrueFor Each key In supportCounts.Keysvalue = supportCounts(key)' 添加分隔符If Not firstItem Thenresult = result & "+"ElsefirstItem = FalseEnd If' 添加支架编号和数量result = result & key & "*" & valueNext key' 清空字典以便下一次使用'supportCounts.RemoveAll' 将结果写入表格ws.Cells(i, outputColumn).value = result' 查询模型并构建新的结果字符串modelResult = ""firstModelItem = TrueFor Each key In supportCounts.Keysvalue = supportCounts(key)' 在“支架型号”工作表中查找对应的模型Dim model As RangeSet model = wsSupport.Range("A:A").Find(What:=key, LookIn:=xlValues, LookAt:=xlWhole)If Not model Is Nothing ThenDim modelValue As StringmodelValue = model.Offset(0, 2).value ' 假设模型位于找到的单元格的右侧' 添加分隔符If Not firstModelItem ThenmodelResult = modelResult & "+"ElsefirstModelItem = FalseEnd If' 添加模型编号和数量modelResult = modelResult & modelValue & "*" & valueEnd IfNext key' 将模型结果写入表格ws.Cells(i, modelColumn).value = modelResultsupportCounts.RemoveAllNext i' 清理Set supportCounts = NothingEnd Sub