请选择 进入手机版 | 继续访问电脑版
设为首页收藏本站

共享社区

 找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

搜索
热搜: 活动 交友 discuz
查看: 736|回复: 3

[求助] 人员自动汇总

[复制链接]

8

主题

9

帖子

15

积分

班长

Rank: 1

威望
0
金钱
37
贡献
0
发表于 2015-10-28 11:02:20 | 显示全部楼层 |阅读模式
想要进行人员自动汇总,好多人和表格,手工添起来好麻烦。

人员自动填写.rar

15.37 KB, 下载次数: 11

回复

使用道具 举报

75

主题

115

帖子

173

积分

管理员

Rank: 9Rank: 9Rank: 9

威望
0
金钱
259
贡献
0
发表于 2015-10-28 11:26:00 | 显示全部楼层
  1. Sub tt()
  2. Dim Arr1, d
  3. Set d = CreateObject("Scripting.Dictionary")
  4.     Arr1 = Workbooks("人员情况表.xls").Sheets(1).Range("A5:B" & [b65536].End(xlUp).Row)
  5.     For i = 1 To UBound(Arr1)
  6.         d(Arr1(i, 1)) = Arr1(i, 2)
  7.     Next
  8.     Mr = [b65536].End(xlUp).Row
  9.     Arr = Range("b8:f" & Mr)
  10.     For i = 1 To UBound(Arr)
  11.         If d.exists(Arr(i, 1)) Then Cells(i + 7, 6) = d(Arr(i, 1))
  12.     Next
  13.     Application.ScreenUpdating = True
  14. End Sub
复制代码
回复 支持 反对

使用道具 举报

75

主题

115

帖子

173

积分

管理员

Rank: 9Rank: 9Rank: 9

威望
0
金钱
259
贡献
0
发表于 2015-10-28 11:27:01 | 显示全部楼层
汇总表.zip (11.93 KB, 下载次数: 5)
回复 支持 反对

使用道具 举报

39

主题

125

帖子

142

积分

排长

Rank: 2

威望
0
金钱
253
贡献
0
发表于 2015-11-24 01:27:20 | 显示全部楼层
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

小黑屋|手机版|Archiver|共享社区 ( 京ICP备15025663号-2  

GMT+8, 2018-12-11 08:04 , Processed in 0.163464 second(s), 24 queries .

Powered by Discuz! X3.4

© 2001-2017 Comsenz Inc.

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