根据2表的姓名匹配单位

xinlan6

liuxi001 发表于 2019-6-12 12:10
If InStr(aa, "负责") + InStr(aa, "地址") + InStr(aa, "电话") +InStr(aa, "合伙人")+ InStr(aa, "负责") ...

谢谢老师的耐心指导

AFree123

liuxi001 发表于 2019-6-12 01:29
其实这里的两个replace替换可以写在re里，因为昨天测试时一直没有匹配到（11人），我以为是括号的问题！！ ...

请教老师，如果要在表1的姓名中标出与表2姓名一致的单元格，如红色底，该如何修改代码，谢谢！

liuxi001

AFree123 发表于 2019-6-12 17:19
请教老师，如果要在表1的姓名中标出与表2姓名一致的单元格，如红色底，该如何修改代码，谢谢！

老师不敢当，这个就简单多了，基本的字典用法就OK了。
将表2的姓名放入字典，再在表一中单元格循环就OK了

liuxi001

多年后看到这个题，尽管是修改过的代码还是有些冗余的地方。
这样好看多了。。。

1. Sub a()
   
2.     '转换
   
3.     ar = Sheet1.[a1].CurrentRegion.Value
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     Set re = CreateObject("vbscript.regexp")
   
6.     re.Pattern = "[\(（]\d+人?[\)）]"
   
7.     For i = 65 To 72
   
8.         d(d.Count + 1) = Chr(i)
   
9.     Next
   
10.     For i = 1 To UBound(ar)
    
11.         s = ar(i, 1)
    
12.         If re.Execute(s).Count > 0 Then
    
13.             gs = re.Replace(Mid(s, InStr(s, ".") + 1), "")
    
14.             Do
    
15.                 i = i + 1
    
16.                 If i > UBound(ar) Then Exit For
    
17.                 ss = ar(i, 1)
    
18.                 If re.Execute(ss).Count = 0 Then
    
19.                     For n = 1 To UBound(ar, 2)
    
20.                         sss = Trim(ar(i, n))
    
21.                         If Len(sss) Then
    
22.                             If Not d.exists(sss) Then
    
23.                                 d(sss) = Array(d(n) & i, gs)
    
24.                             Else
    
25.                                 d(sss) = Array(d(sss)(0) & "、" & d(n) & i, d(sss)(1) & "、" & gs)
    
26.                             End If
    
27.                         End If
    
28.                     Next
    
29.                 Else
    
30.                     i = i - 1
    
31.                     Exit Do
    
32.                 End If
    
33.             Loop
    
34.         End If
    
35.     Next
    
36.     '匹配
    
37.     Sheet2.[a1].CurrentRegion.Offset(2, 10).Resize(, 2).ClearContents
    
38.     br = Sheet2.[a1].CurrentRegion
    
39.     For i = 3 To UBound(br)
    
40.         s = Trim(br(i, 4))
    
41.         If d.exists(s) Then
    
42.             br(i, 11) = "表1中" & d(s)(0)
    
43.             br(i, 12) = d(s)(1)
    
44.         Else
    
45.             br(i, 11) = "未查到"
    
46.         End If
    
47.     Next
    
48.     Sheet2.[a1].CurrentRegion = br
    
49. End Sub
    

复制代码

APPLE123

liuxi001 发表于 2023-8-23 13:53
多年后看到这个题，尽管是修改过的代码还是有些冗余的地方。
这样好看多了。。。

几年过去了，还在锲而不舍的研究，为这种精益求精的精神点赞

APPLE123

liuxi001 发表于 2023-8-23 13:53
多年后看到这个题，尽管是修改过的代码还是有些冗余的地方。
这样好看多了。。。

刚好工作中遇到的实例与原贴比较贴近。与原贴相比较，就是核对的关键字是2列，姓名+证号。原贴的关键字只有姓名1列
为此改造请教。麻烦老师帮忙看看，该如何修改您的代码，谢谢！

blackttea1

感兴趣，学习啦

liuxi001

APPLE123 发表于 2023-8-27 17:04
刚好工作中遇到的实例与原贴比较贴近。与原贴相比较，就是核对的关键字是2列，姓名+证号。原贴的关键字只 ...

你的表1没有数据

APPLE123

liuxi001 发表于 2023-9-4 10:38
你的表1没有数据

老师好！谢谢您的回复。
表1有数据啊，您现在看到的单元格起始位置在G1，麻烦老师将表格向左拉到A列即可看到了。辛苦老师了，谢谢！

APPLE123

liuxi001 发表于 2023-9-4 10:38
你的表1没有数据

老师您好！数据在A1:F121区域，麻烦老师再看看，谢谢！