VBA批量判断是否包含某些关键字，包含则提取内容

yuchidanyang

查询表和数据表中是包含关系，请问这样的情况需要怎么编写代码？
如：查询表中部门信息是A，数据表中标题列的内容包含A但不仅限于A
求各位大佬指教




下面是参考代码，只有部门列内容等于标题列时才可用，请问怎么改？

1. Sub 跨工作簿查询()
   
2.     Dim Sht As Worksheet '查询工作表
   
3.     Dim wkb_data As Workbook '数据工作簿
   
4.     Dim fullpath As String '路径带工作簿名称
   
5.     Dim i As Long
   
6.     fullpath = ThisWorkbook.Path & "\小狗.xlsx"
   
7.     Application.ScreenUpdating = False
   
8.     '第一部分：打开工作簿
   
9.     Set Sht = ThisWorkbook.Sheets("查询表") '数据查询表
   
10.     Set wkb_data = Workbooks.Open(fullpath) '打开数据所在的工作簿
    
11.     '第二部分：vba代码操作，获取目标数据
    
12.     With Sheets("数据表")
    
13.         For i = 2 To Sht.Cells(Rows.Count, 1).End(xlUp).Row '遍历查询表要查询数据的部门
    
14.             For j = 2 To .Cells(Rows.Count, 1).End(xlUp).Row '遍历数据
    
15.                 If Sht.Cells(i, 1) = .Cells(j, 1) Then '按部门查询
    
16.                    Sht.Cells(i, 2) = .Cells(j, 2) '输出销售额
    
17.                    Exit For '有结果就退出当前循环,不再继续遍历下去
    
18.                 End If
    
19.             Next
    
20.         Next
    
21. End With
    
22. '第三部分：关闭工作簿
    
23. wkb_data.Close False '关闭工作簿,不保存更改
    
24. Set wkb_data = Nothing '释放对象变量
    
25. Application.ScreenUpdating = True
    
26. End Su

复制代码

liulang0808

If Sht.Cells(i, 1) = .Cells(j, 1) Then
If instr(Sht.Cells(i, 1) , .Cells(j, 1))> 0 Then  看看包含关系，自己调整是否可行吧

yuchidanyang

liulang0808 发表于 2023-4-26 19:34
If Sht.Cells(i, 1) = .Cells(j, 1) Then
If instr(Sht.Cells(i, 1) , .Cells(j, 1))> 0 Then  看看包 ...

非常感谢，已经通过instr函数写出来了，现在还有个问题
判断存在“包含”关系后，需要从标题列中提取“部分数据”内容填写到指定单元格
如"AAAAAA（B）CCC  DDDDDDDD"这种类型的数据
所在位置不同，长度有些相同有些不同，我应该如何提取?

yuchidanyang

liulang0808 发表于 2023-4-26 19:34
If Sht.Cells(i, 1) = .Cells(j, 1) Then
If instr(Sht.Cells(i, 1) , .Cells(j, 1))> 0 Then  看看包 ...

刚才百度了“正则表达式”的做法，不知道是否适用现有的情况

liulang0808

yuchidanyang 发表于 2023-4-27 10:41
非常感谢，已经通过instr函数写出来了，现在还有个问题
判断存在“包含”关系后，需要从标题列中提取“ ...

建议上传模拟附件，结合附件详细说明下
这样描述，不清楚具体需求的