设为首页收藏本站
开启辅助访问

Excel精英培训网

 找回密码
 注册
Excel精英培训网»论坛 › Excel 求助区 › Excel VBA开发 › 如何用VBA，将员工对应的编号，筛选在对应的编码表中。
数据透视表40+个常用小技巧，让你一次学会！
返回列表 发新帖
查看: 2917|回复: 9

[已解决]如何用VBA，将员工对应的编号，筛选在对应的编码表中。

[复制链接]
新一
发表于 2014-3-24 18:45 | 显示全部楼层 |阅读模式
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
如何用VBA，将员工对应的编号，筛选在对应的编号表中。如我的附件，总表，时工，装模三个工作表，将员工对应的编号，筛选在对应的编号表中，如“1”的效果。可否做到。
最佳答案
月排行榜 / 总排行榜
dsmch
2014-3-24 21:40
  1. Sub Macro1()
  2. On Error Resume Next
  3. Dim arr, i&, j%, x&, y&
  4. arr = Sheets("编号").Range("a1").CurrentRegion
  5. For j = 5 To Sheets.Count
  6.     Sheets(j).UsedRange.Clear
  7. Next
  8. For i = 2 To UBound(arr)
  9.     zf = "" & arr(i, 2)
  10.     For j = 2 To 4
  11.         With Sheets(j)
  12.             x = Sheets(zf).UsedRange.Find(arr(i, 2), SearchDirection:=xlPrevious).Row
  13.             y = IIf(j = 2, 1, x + 2)
  14.             .Range("I1").AutoFilter Field:=9, Criteria1:=arr(i, 2)
  15.             .UsedRange.SpecialCells(xlCellTypeVisible).Copy Sheets(zf).Cells(y, 1)
  16.             .ShowAllData
  17.         End With
  18.     Next
  19.     x = Sheets(zf).UsedRange.Find(arr(i, 2), SearchDirection:=xlPrevious).Row
  20.     Union(Sheets(zf).Range(x + 1 & ":" & 20000), Sheets(zf).[i:i]).Clear
  21.     Sheets(zf).[i1] = Application.Sum(Sheets(zf).Range("g2:g" & x))
  22. Next
  23. End Sub
复制代码
I1有金额总合计

如何

附件员工.rar

4.16 KB, 下载次数: 6

相关帖子
回复

使用道具 举报

工作中最常用的函数公式，全印在一张超大的鼠标垫上
dsmch
发表于 2014-3-24 20:50 | 显示全部楼层
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
  1. Sub Macro1()
  2. On Error Resume Next
  3. Dim arr, i&, j%, x&, y&
  4. arr = Sheets("编号").Range("a1").CurrentRegion
  5. For j = 5 To Sheets.Count
  6.     Sheets(j).UsedRange.Clear
  7. Next
  8. For i = 2 To UBound(arr)
  9.     zf = "" & arr(i, 2)
  10.     For j = 2 To 4
  11.         With Sheets(j)
  12.             x = Sheets(zf).UsedRange.Find(arr(i, 2), SearchDirection:=xlPrevious).Row
  13.             y = IIf(j = 2, 1, x + 2)
  14.             .Range("I1").AutoFilter Field:=9, Criteria1:=arr(i, 2)
  15.             .UsedRange.SpecialCells(xlCellTypeVisible).Copy Sheets(zf).Cells(y, 1)
  16.             .ShowAllData
  17.         End With
  18.     Next
  19.     x = Sheets(zf).UsedRange.Find(arr(i, 2), SearchDirection:=xlPrevious).Row
  20.     Sheets(zf).[i1] = Application.Sum(Sheets(zf).Range("g2:g" & x))
  21.     Sheets(zf).Range(x + 1 & ":" & 20000).Clear
  22. Next
  23. End Sub
复制代码
回复

使用道具 举报

dsmch
发表于 2014-3-24 20:52 | 显示全部楼层
工作中最常用的Excel函数公式，全印在一张鼠标垫上
………………

附件员工.zip

24.52 KB, 下载次数: 17
回复

使用道具 举报

新一
 楼主| 发表于 2014-3-24 21:18 | 显示全部楼层
dsmch 发表于 2014-3-24 20:52
………………

谢谢帮助，问一下工作表1中，编号栏可否不显视？
附件.gif
回复

使用道具 举报

dsmch
发表于 2014-3-24 21:40 | 显示全部楼层    本楼为最佳答案   
  1. Sub Macro1()
  2. On Error Resume Next
  3. Dim arr, i&, j%, x&, y&
  4. arr = Sheets("编号").Range("a1").CurrentRegion
  5. For j = 5 To Sheets.Count
  6.     Sheets(j).UsedRange.Clear
  7. Next
  8. For i = 2 To UBound(arr)
  9.     zf = "" & arr(i, 2)
  10.     For j = 2 To 4
  11.         With Sheets(j)
  12.             x = Sheets(zf).UsedRange.Find(arr(i, 2), SearchDirection:=xlPrevious).Row
  13.             y = IIf(j = 2, 1, x + 2)
  14.             .Range("I1").AutoFilter Field:=9, Criteria1:=arr(i, 2)
  15.             .UsedRange.SpecialCells(xlCellTypeVisible).Copy Sheets(zf).Cells(y, 1)
  16.             .ShowAllData
  17.         End With
  18.     Next
  19.     x = Sheets(zf).UsedRange.Find(arr(i, 2), SearchDirection:=xlPrevious).Row
  20.     Union(Sheets(zf).Range(x + 1 & ":" & 20000), Sheets(zf).[i:i]).Clear
  21.     Sheets(zf).[i1] = Application.Sum(Sheets(zf).Range("g2:g" & x))
  22. Next
  23. End Sub
复制代码
I1有金额总合计

回复

使用道具 举报

新一
 楼主| 发表于 2014-3-24 21:42 | 显示全部楼层
dsmch 发表于 2014-3-24 21:40
I1有金额总合计

可否将金额合计转到如图的位置，谢谢。
附件.gif
回复

使用道具 举报

dsmch
发表于 2014-3-24 21:53 | 显示全部楼层
新一 发表于 2014-3-24 21:42
可否将金额合计转到如图的位置，谢谢。

应该能做到，不过代码太繁杂，影响代码运行效率；再者，明细汇总有总金额不是一目了然了吗？
回复

使用道具 举报

新一
 楼主| 发表于 2014-3-24 21:56 | 显示全部楼层
dsmch 发表于 2014-3-24 21:53
应该能做到，不过代码太繁杂，影响代码运行效率；再者，明细汇总有总金额不是一目了然了吗？

好的，那么可不可以加一个备注字：金额：584，的样式，我怕员工看不明。
回复

使用道具 举报

dsmch
发表于 2014-3-24 21:59 | 显示全部楼层
Sheets(zf).[i1] = "金额：" & Application.Sum(Sheets(zf).Range("g2:g" & x))
回复

使用道具 举报

新一
 楼主| 发表于 2014-3-24 22:07 | 显示全部楼层
dsmch 发表于 2014-3-24 21:59
Sheets(zf). = "金额：" & Application.Sum(Sheets(zf).Range("g2:g" & x))

非常感谢
回复

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-4-26 12:44 , Processed in 0.272296 second(s), 11 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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