ExcelTip.Net留存知识帖 ---【注:附件之前被网盘供应商清空后,现已修复-现已修复-现已修复为本地下载!】
现在位置:首页 > 我的酷贴 > Excel VBA > 如何把两个工作簿的项目合并?

如何把两个工作簿的项目合并?

作者:绿色风 分类: 时间:2022-08-18 浏览:136
楼主
liuguansky
Q:有两个EXCEL表格表格一中没有身份证号码这一列,要在表格二中把对应人名字的身份证号码复杂到表格一中。要求在表一中新建一列用来表示身份证号码,并且要注意同名的情况,两张表格中有相同的列就是名字和学号。请求高人指点啊。

你可以看见两个表格有保险费和学生卡号信息两张表格 现在要在学生卡号里面对应人身份证号码复制到保险费表格里面去

要求 注意同名情况 在表学生卡号信息中找不到身份证号码的在表一中标注出来。
A:
确定两个工作簿在一个文件夹内,在保险费工作簿中,添加模板,加入代码,运行即可。
代码如下:


  1. Sub justtest()
  2.   Application.ScreenUpdating = False
  3.   Workbooks.Open (ThisWorkbook.Path & "\学生校园卡卡号信息(09年12月31日).xls")
  4.   Dim i&, dic, dic1, j&
  5.   Set dic = CreateObject("scripting.dictionary")
  6.   Set dic1 = CreateObject("scripting.dictionary")
  7.   With Sheets(1)
  8.     For i = 2 To .Cells(.Rows.Count, 3).End(3).Row
  9.       If dic.exists(.Cells(i, 3).Value) Then
  10.         If dic(.Cells(i, 3).Value) = "" Then
  11.           dic(.Cells(i, 3).Value) = .Cells(i, 6).Value
  12.         End If
  13.       Else: dic.Add .Cells(i, 3).Value, .Cells(i, 6).Value
  14.       End If
  15.     Next i
  16.   End With
  17.   ActiveWorkbook.Close
  18.   With Workbooks("保险费(9月28日).xls").Sheets(1)
  19.     .Range("e:e").ClearContents
  20.     .Range("e:e").NumberFormatLocal = "@"
  21.     .Range("e1") = "身份证号码"
  22.     For j = 2 To .Cells(.Rows.Count, 2).End(3).Row
  23.       If dic.exists(.Cells(j, 2).Value) Then
  24.         dic1(j) = dic(.Cells(j, 2).Value)
  25.         Else: dic1(j) = "未有身份证记录"
  26.       End If
  27.     Next j
  28.     .Cells(2, 5).Resize(dic1.Count, 1) = Application.Transpose(dic1.items)
  29.     End With
  30.     Set dic1 = Nothing
  31.     Set dic = Nothing
  32.     Application.ScreenUpdating = True
  33.    MsgBox "身份证返回成功"
  34. End Sub

保险费(9月28日).rar
2楼
海洋之星
学习了,
3楼
初学者2012
学习了,字典很强大**

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素, 经与ExcelTip.Net站长Apolloh商议并征得其同意, 现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示, 供有需要的人士查询使用,也慰缅曾经的论坛时代。 所示各个帖子的原作者如对版权有异议, 可与本人沟通提出,或于本站点留言,我们会尽快处理。 在此,感谢ExcelTip.Net站长Apolloh的支持,感谢本站点所有人**绿色风(QQ:79664738)**的支持与奉献,特此鸣谢!
------本人网名**KevinChengCW(QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表
sitemap