ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 815|回复: 6

[求助] 数据查找和填充合并问题

[复制链接]

TA的精华主题

TA的得分主题

发表于 2019-9-6 22:06 | 显示全部楼层 |阅读模式
数据查找和复制问题.rar (18.75 KB, 下载次数: 3) 要求在B里面,谢谢高手!

TA的精华主题

TA的得分主题

发表于 2019-9-6 22:13 | 显示全部楼层
??? A簿只有3列数字,B簿只有一个说明。 姓名呢? 看不懂。 111111.png

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-9-6 22:18 | 显示全部楼层
moonlit123 发表于 2019-9-6 22:13
??? A簿只有3列数字,B簿只有一个说明。 姓名呢? 看不懂。

A的姓名在lJ列,B里面我用手工填上一个例子了

TA的精华主题

TA的得分主题

发表于 2019-9-6 22:24 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
小女孩 发表于 2019-9-6 22:18
A的姓名在lJ列,B里面我用手工填上一个例子了

A簿里有重复姓名的,怎么处理? 去重复?还是算两个?

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-9-6 22:36 | 显示全部楼层
moonlit123 发表于 2019-9-6 22:24
A簿里有重复姓名的,怎么处理? 去重复?还是算两个?

这个不用考虑,实际上是不出现的,您先删除就行了,我可能举例子时候没注意

TA的精华主题

TA的得分主题

发表于 2019-9-6 23:02 | 显示全部楼层
  1. Sub 从表A填入表B()
  2. Dim sh, i, j, R, MyPath, MyName
  3. Dim arr(), brr()  '数组

  4. MyPath = ThisWorkbook.Path & ""
  5. MyName = "A.xlsm"                '文件名A
  6.      
  7. With Workbooks.Open(MyPath & MyName)   '打开A簿并复制数据,关闭并不保存
  8. sh = "2019"
  9. R = .Sheets(sh).Range("J65536").End(xlUp).Row
  10. arr = .Sheets(sh).Range("A1:J" & R).Value
  11. .Close False
  12. End With

  13. sh = "成绩录入"                        '获取B簿K姓名
  14. R = ThisWorkbook.Sheets(sh).Range("K65536").End(xlUp).Row
  15. brr = ThisWorkbook.Sheets(sh).Range("K2:N" & R).Value

  16. For j = 1 To UBound(brr)            '对比姓名,匹配则复制数据
  17. For i = 1 To UBound(arr)
  18. If brr(j, 1) = arr(i, 10) Then
  19. brr(j, 2) = arr(i, 3)
  20. brr(j, 3) = arr(i, 4)
  21. brr(j, 4) = arr(i, 5)
  22. arr(i, 10) = ""
  23. End If
  24. Next
  25. Next

  26. ThisWorkbook.Sheets(sh).Range("K2:N" & R) = brr    '数据填到已有姓名对应行

  27. For i = 1 To UBound(arr)                           '补充其他姓名及数据
  28. If arr(i, 10) <> "" Then
  29. R = R + 1
  30. ThisWorkbook.Sheets(sh).Cells(R, 11) = arr(i, 10)
  31. ThisWorkbook.Sheets(sh).Cells(R, 11).Font.ColorIndex = 3    '姓名标红
  32. ThisWorkbook.Sheets(sh).Cells(R, 12) = arr(i, 3)
  33. ThisWorkbook.Sheets(sh).Cells(R, 13) = arr(i, 4)
  34. ThisWorkbook.Sheets(sh).Cells(R, 14) = arr(i, 5)
  35. End If
  36. Next

  37. End Sub

复制代码

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2019-9-6 23:06 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 23:40 , Processed in 0.050824 second(s), 15 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表