根据2表的姓名匹配单位

xinlan6

根据2表的姓名匹配单位

一、sheet1基本结构

1、按地区排列，每个地区公司数量不等

2、每个公司基本内容为：负责人、地址、电话、人员姓名，前3项各占一行，人员姓名每行8人，即8列，据实填列

3、每个单位名称前面都有数字序号，格式为：数字+点+名称

      但是单位下面有省内分公司的，就直接跟在总公司后面

       分公司名称前面，不编号，即没有数字+点   。如A27、A33

       分公司基本结构同总公司一样，都是负责人、地址、电话、人员姓名。

       总公司在省外的分公司，视同一般公司管理，故格式为：数字+点+名称 。如A45、A81

4、每个单位人数不等，有多有少，但至少2人以上，具体人数标注在单位名称后面的括号内

5、注意：有些人姓名前后有空格

6、数据很多，大约有500个单位，近万个人员，本例仅是部分范例

二、Sheet2信息很多，关键信息：姓名，且表2姓名无重复

三、核对2表姓名，将Sheet2的D列姓名匹配Sheet1A：H区域的姓名

        如果一致，则在Sheet2的K列填写“表1中xx 单元格地址”，便于人工复核判断，在Sheet2的L列填写该姓名在Sheet1所属的单位名称（后面有无人数均可）

        考虑可能存在同名同姓，如果有多个一致的姓名，全部找出，填写时使用顿号隔开。

       如果一致，则在Sheet2的K列填写“未查到”

        数据模拟结果，详见Sheet2的K列、L列黄底红色字。

四、与常规核对匹配有点区别，主要是sheet1的结果不是一个字段一列数据。有点难度

请大神帮帮忙，谢谢！

fanyoulin

初略看了下，做也做得了，可能要涉及字典+数组，加上sheet1的不规范，写代码的时间会比较长。
今天我估计别人没时间写，明天应该有人帮你写的。

xinlan6

fanyoulin 发表于 2019-6-11 16:40
初略看了下，做也做得了，可能要涉及字典+数组，加上sheet1的不规范，写代码的时间会比较长。
今天我估计 ...

谢谢老师！麻烦老师！辛苦老师！

xinlan6

要是实在太难了，就分步走
先将表1转化为标准格式
在将表2与新表核对标注
得到相近的结果就好
真是辛苦老师了，谢谢！

liuxi001

1. Sub a()
   
2.     '转换
   
3.     ar = Sheet1.[a1].CurrentRegion
   
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.             m = i
    
15.             Do
    
16.                 m = m + 1
    
17.                 If m > UBound(ar) Then GoTo errh
    
18.                 ss = ar(m, 1)
    
19.                 If re.Execute(ss).Count = 0 Then
    
20.                     If InStr(ss, "负责") + InStr(ss, "地址") + InStr(ss, "电话") + InStr(ss, "合伙") + InStr(ss, "、") = 0 Then
    
21.                         For n = 1 To UBound(ar, 2)
    
22.                             sss = Trim(ar(m, n))
    
23.                             If Len(sss) Then
    
24.                                 If Not d.exists(sss) Then
    
25.                                     d(sss) = Array(d(n) & m, gs)
    
26.                                 Else
    
27.                                     d(sss) = Array(d(sss)(0) & "、" & d(n) & m, d(sss)(1) & "、" & gs)
    
28.                                 End If
    
29.                             End If
    
30.                         Next
    
31.                     End If
    
32.                 Else
    
33.                     i = m - 1
    
34.                     Exit Do
    
35.                 End If
    
36.             Loop
    
37.         End If
    
38.     Next
    
39. errh:
    
40.     '匹配
    
41.     br = Sheet2.[a1].CurrentRegion
    
42.     For i = 3 To UBound(br)
    
43.         s = Trim(br(i, 4))
    
44.         If d.exists(s) Then
    
45.             br(i, 11) = "表1中" & d(s)(0)
    
46.             br(i, 12) = d(s)(1)
    
47.         Else
    
48.             br(i, 11) = "未查到"
    
49.         End If
    
50.     Next
    
51.     Sheet2.[a1].CurrentRegion = br
    
52. End Sub
    

复制代码

其实这里的两个replace替换可以写在re里，因为昨天测试时一直没有匹配到（11人），我以为是括号的问题！！！后面才写了替换,之后就没改了。。
re.pattern="(\(|（)\d+人?(\)|）)"

gs = re.Replace(Mid(s, InStr(s, ".") + 1), "")
是提取公司名，Mid(s, InStr(s, ".") + 1)提取.后面的全部字符，re.Replace(ss,"")将正则匹配到的（11人）替换为空。


这样修改后还清爽一点。

xinlan6

liuxi001 发表于 2019-6-12 01:29

谢谢老师！真是辛苦老师了！
这让我看到了VBA的强大，一定要好好学习。
再请教老师：
1、For m = tempr To tempr + 30，这里为何是+30
2、s = Replace(Replace(s, "（", "("), "）", ")")
aa = Replace(Replace(aa, "（", "("), "）", ")")
都是替换，为何换2次
3、 gs = re.Replace(Mid(s, InStr(s, ".") + 1), "")，具体意思是什么
4、If Not d.exists(sss) Then
          d(sss) = Array(d(n) & m, gs)
      Else
          d(sss) = Array(d(sss)(0) & "、" & d(n) & m, d(sss)(1) & "、" & gs)
     这是什么意思？
麻烦老师，有空时帮忙解答。谢谢！

liuxi001

30是随手写的，找到一个公司后向下循环30行，再次找到公司名称跳出循环，这里用do loop更合适
有左右两个括号，下面的替换还有没有必要没细想
后面是字典用法
转钟看到题目写得粗糙，看着改吧

xinlan6

liuxi001 发表于 2019-6-12 07:50
30是随手写的，找到一个公司后向下循环30行，再次找到公司名称跳出循环，这里用do loop更合适
有左右两个 ...

谢谢老师的指导！
请问：
If InStr(aa, "负责") + InStr(aa, "地址") + InStr(aa, "电话") = 0 Then
这一句表示：如果不含有负责人、地址、电话等字符，那么.......
如果要表达如下：
如果不含有“负责人、地址、电话”或者“法定代表人、地址、电话”或者“合伙人、地址、电话”等字符，那么......
也就是“地址、电话”不变，“负责人”可以更改为“法定代表人”“合伙人”等字符
请问该如何修改，这一句的表达。谢谢老师！

liuxi001

If InStr(aa, "负责") + InStr(aa, "地址") + InStr(aa, "电话") +InStr(aa, "合伙人")+ InStr(aa, "负责")+ InStr(aa, "法定代表人") = 0 Then
这一句其实无关紧要，因为就算是写入字典，你的查找表中也没有人是这样的姓名