ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

[求助] 想在excel中增加VBA,按指定条件筛选后,筛选出来的信息自动转移到另一张表格里

[复制链接]

TA的精华主题

TA的得分主题

发表于 2016-6-26 11:39 | 显示全部楼层 |阅读模式
本帖最后由 quanyongs 于 2016-6-26 11:42 编辑

想在excel中增加VBA,按指定条件筛选后,删选出来的信息自动转移到另一张表格里

如附件所示:增加VBA程序:点击按钮,程序执行后,由总表自动筛选出离职员工和未成年工,并将所有信息放入指定工作表。
QQ截图20160626113703.png
如图:程序执行后,将“所有员工”中的未成年工和离职员工自动筛选到后面两张表格里,原工作表中信息保留

2016花名册-第一版.rar

174.99 KB, 下载次数: 122

TA的精华主题

TA的得分主题

发表于 2016-6-26 12:01 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2016-6-26 12:39 | 显示全部楼层
新建1个模块,粘贴代码
  1. Sub 保存()
  2.     Dim Message, Title, Default, MyValue
  3.     Message = "请选择将记录另存至哪张工作表" & Chr(10) & "1代表离职员工,2代表未成年员工" ' 设置提示信息。
  4.     Title = "保存"    ' 设置标题。
  5.     Default = "1"    ' 设置缺省值。
  6.     ' 显示信息、标题及缺省值。
  7.     MyValue = InputBox(Message, Title, Default)
  8.     Select Case MyValue
  9.         Case 1
  10.         Sheet1.Range("A3:Y" & Sheet1.Range("A65536").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy _
  11.         Sheet2.Range("a" & Sheet2.Range("A65536").End(xlUp).Row + 1)
  12.         Case 2
  13.         Sheet1.Range("A3:Y" & Sheet1.Range("A65536").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy _
  14.         Sheet3.Range("a" & Sheet3.Range("A65536").End(xlUp).Row + 1)
  15.     End Select
  16. End Sub
复制代码

TA的精华主题

TA的得分主题

 楼主| 发表于 2016-6-26 16:44 | 显示全部楼层
zhouxiao 发表于 2016-6-26 12:39
新建1个模块,粘贴代码

谢谢你,不过可能您没理解我的意思,我意思是:
将总表的数据按条件筛选后,将筛选后的数据复制到另外一张表。
比如要筛选离职员工,根据离职日期,筛选出已经离职的员工,然后将这些离职员工的信息复制到工作表“离职员工”中。
比如要筛选未成年工,根据他们入职年龄,筛选出未成年工,然后将这些未成年工的信息复制到另外一个工作表中。
您写的代码是将所有员工的信息都复制到了另外一张表格里面,并没有进行筛选。

TA的精华主题

TA的得分主题

发表于 2016-6-26 17:01 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
Private Sub CommandButton1_Click()
  Dim h As Long
  For h = 3 To Range("a10000").End(xlUp).Row
    If Cells(h, "s") <> "" And Cells(h, "s").NoteText = "" Then
      Range(Cells(h, 1), Cells(h, 25)).Copy Sheet2.Cells(Sheet2.Range("a10000").End(xlUp).Row + 1, 1)
      Sheet2.Cells(Sheet2.Range("a10000").End(xlUp).Row, "s").NoteText "已转录到离职员工"
    End If
    If Cells(h, "v") <= 18 And Cells(h, "v").NoteText = "" Then
      Range(Cells(h, 1), Cells(h, 25)).Copy Sheet3.Cells(Sheet3.Range("a10000").End(xlUp).Row + 1, 1)
      Sheet3.Cells(Sheet3.Range("a10000").End(xlUp).Row, "v").NoteText "已转录到未成年员工"
    End If
  Next h
End Sub
考虑到档案资料的保存,在原表中为删除,但做了记号,未改变原表结构,只对离职和未成年的加了注释,再不会二次转录。

TA的精华主题

TA的得分主题

发表于 2016-6-26 17:04 | 显示全部楼层
Private Sub CommandButton1_Click()
  Dim h As Long
  For h = 3 To Range("a10000").End(xlUp).Row
    If Cells(h, "s") <> "" And Cells(h, "s").NoteText = "" Then
      Range(Cells(h, 1), Cells(h, 25)).Copy Sheet2.Cells(Sheet2.Range("a10000").End(xlUp).Row + 1, 1)
      Sheet2.Cells(Sheet2.Range("a10000").End(xlUp).Row, "s").NoteText "已转录到离职员工"
    End If
    If Cells(h, "v") <= 18 And Cells(h, "v").NoteText = "" Then
      Range(Cells(h, 1), Cells(h, 25)).Copy Sheet3.Cells(Sheet3.Range("a10000").End(xlUp).Row + 1, 1)
      Sheet3.Cells(Sheet3.Range("a10000").End(xlUp).Row, "v").NoteText "已转录到未成年员工"
    End If
  Next h
End Sub
考虑资料的保存,对原表未做删除处理,但做了记号,不会二次转录。

TA的精华主题

TA的得分主题

发表于 2016-6-26 17:07 | 显示全部楼层
忘了传附件。

2016花名册-第一版.rar

193.11 KB, 下载次数: 503

TA的精华主题

TA的得分主题

 楼主| 发表于 2016-6-26 17:13 | 显示全部楼层
谢谢你,完美解决,待我好好研究研究

TA的精华主题

TA的得分主题

发表于 2016-6-26 19:33 | 显示全部楼层
quanyongs 发表于 2016-6-26 16:44
谢谢你,不过可能您没理解我的意思,我意思是:
将总表的数据按条件筛选后,将筛选后的数据复制到另外 ...

你在总表里面分别筛选出离职员工和未成年员工后,再运行这个代码,就知道效果了

TA的精华主题

TA的得分主题

 楼主| 发表于 2016-6-26 19:50 | 显示全部楼层
zhouxiao 发表于 2016-6-26 19:33
你在总表里面分别筛选出离职员工和未成年员工后,再运行这个代码,就知道效果了

谢谢你,不过还是要多点几下
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-3-28 22:09 , Processed in 0.053804 second(s), 9 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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