再次烦请大神chxw68及各位高手帮忙 ，实现新的查询功能

xwq680812

    如题，工作簿里有55个工作表,前1-5个工作表分别为“收费统计”、“收费统计2”、“党员名单”、“不重复名单”、“合并名单”。第6-55个工作表是50个班级的名单，学员信息从每个工作表的A5单元格开始录入,各班人数不同（为方便，上传的附件里只有四个班级）。

    2018年1月在大神chxw68的帮助下已经实现清除、合并、查询党员、去重复人员等共5个VBA功能。

    例：在第6-55个工作表中运行宏test5，则通过查询姓名及身份证号是否与第3个表格“党员名单”中完全相同（预防重名）的方法，来确定学员是否为党员，如果是党员则在该工作表K列单元格填入“党员”字样。类似地，在第5个“合并名单”工作表中运行宏test3，能自动查询该工作表中所有学员是否在第3个表格“党员名单”中出现，如果姓名和身份证为同一人，就在该工作表K列单元格填入“党员”字样。

    现在我想要进一步达到的效果是：

    1.修改宏test5、宏test3这两个宏，除了在K列单元格填入“党员”之外，还能够在后面的L列中填入该学员的入党日期（入党日期在第3个“党员名单”工作表中的Q列）。

    2.如果仅运行宏test5一次，就能在第6-55个班级名册工作表中填入党员及入党日期，那么这个宏test5又该怎么修改呢？

     再次烦请大神chxw68及各位高手帮忙，万分感谢！！！！！

xwq680812

烦请大神帮忙！

iwangyi

7个表，4个格式，呵呵

xiangbaoan

…………按你的需求，改了几处………

jiminyanyan

这个字体挺漂亮。。。

一指禅62

1. Sub 填表()
   
2.     Dim d As Object, Sh As Worksheet, Rng As Range, arr, i&
   
3.     arr = Sheets("党员名单").Range("A1").CurrentRegion
   
4.     If UBound(arr) < 6 Then MsgBox "“党员名单”工作表没有相关信息！", , "消息框": Exit Sub
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     For i = 6 To UBound(arr)
   
7.         If Trim(arr(i, 4)) <> "" Then d(Trim(arr(i, 4))) = arr(i, 17)
   
8.     Next
   
9.     For Each Sh In ThisWorkbook.Worksheets
   
10.         If Sh.Name <> "收费统计" And Sh.Name <> "收费统计2" And Sh.Name <> "党员名单" _
    
11.             And Sh.Name <> "不重复名单" And Sh.Name <> "合并名单" Then
    
12.             Set Rng = Sh.Range("E5")
    
13.             Do While Rng <> ""
    
14.                 If d.Exists(Rng.Value) Then
    
15.                     Rng.Offset(0, 6).Resize(1, 2) = Array("党员", d.Item(Rng.Value))
    
16.                 Else
    
17.                     Rng.Offset(0, 6).Resize(1, 2) = ""
    
18.                 End If
    
19.                 Set Rng = Rng.Offset(1, 0)
    
20.             Loop
    
21.         End If
    
22.     Next
    
23. End Sub

复制代码

xwq680812

jiminyanyan 发表于 2018-8-18 10:15
这个字体挺漂亮。。。

这个字体是“仿宋_GB2312”，一般设成4号字体，行间距26左右吧！

xwq680812

xiangbaoan 发表于 2018-8-18 09:17
…………按你的需求，改了几处………

谢谢了，非常感谢你的帮助！我下载了，好好研究一下！有问题我再请教你！

xwq680812

xiangbaoan 发表于 2018-8-18 09:17
…………按你的需求，改了几处………

xiangbaoan老师：    你好，感谢你的帮助！
    我下载了你帮我修改的附件，认真和原来比较了！有2个问题请教：
    1.宏“模块3.test5”  与 宏 “模块5.test5”这两个的功能是否是一样的？都是在6-55班级名册工作表里填上党员及入党日期，但一个是从“党员名册”工作表里查询，另一个是“从合并名单”工作表里查询。不知我的理解是否正确，希望能得到你的解惑！
    2.发现了一个新的问题：“合并名单”工作表里，“班级”字段原来在L列，运行宏“去重复”后，能根据“合并名单”工作表得到“不重复名单”工作表，表里没有重复学员（重复的学员只剩一行，但是该行最后显示了他报读的所有班级）。但由于合并名单增加了字段“入党日期”后，“班级”字段右移一位放在了L列，导致运行宏“去重复”后，不能得到学员的报读班级名称了（如下面图片所示），这种情况下不知道又应该怎样修改宏“去重复”？希望能得到你的帮助！
   为了能把问题直观表示，我把工作表稍作修改，上传作为新的附件！
合并查询VBA修改.rar (64.55 KB, 下载次数: 4)

2018-8-19 13:20 上传

点击文件名下载附件

xwq680812

一指禅62 发表于 2018-8-18 16:24

    你好，我下载了尝试了，运行宏“填表”之后，后面的四个班级名册工作表中，有一个工作表（第三个）的党员没有入党日期。因水平有限，我查不出原因，烦请你解惑！
    非常感谢你的帮助！