Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 3882|回复: 13

[已解决]excel自动筛选代码问题

[复制链接]
发表于 2014-10-13 09:43 | 显示全部楼层 |阅读模式
本帖最后由 nangongyixun 于 2014-10-13 10:09 编辑

QQ图片20141013093508.jpg


如上图
在明细表中输入所有的内容

要求后面标准件、零部件和借用件都能自动筛选生成
跪求高手指点

具体表格见附件

注:1、标准件就是图号为GB/T开头的,零部件就是图号开头与表格C2里的编码一样的,借用件就是图号开头GB/T和PE005S以外的;
2、标准件、零部件和借用件里的表格和上图明细表里的一模一样,只是按类区分开而已。


最佳答案
2014-10-13 10:32
  1. Sub tt()
  2.     Dim Rng1 As Range, Rng2 As Range, Rng3 As Range
  3.     Dim Rng As Range
  4.     r = [a65536].End(3).Row
  5.     For i = 5 To r
  6.         th = Trim(Cells(i, 2))
  7.         Set Rng = Cells(i, 1).Resize(1, 7)
  8.         If th Like "GB*" Then
  9.             If Rng1 Is Nothing Then Set Rng1 = Rng Else Set Rng1 = Union(Rng1, Rng)
  10.         ElseIf th = Trim([a2]) Then
  11.             If Rng2 Is Nothing Then Set Rng2 = Rng Else Set Rng2 = Union(Rng2, Rng)
  12.         ElseIf Len(th) > 0 Then
  13.             If Rng3 Is Nothing Then Set Rng3 = Rng Else Set Rng3 = Union(Rng3, Rng)
  14.         End If
  15.     Next
  16.     Rng1.Copy Sheet2.[a5]
  17.     Rng2.Copy Sheet3.[a5]
  18.     Rng3.Copy Sheet4.[a5]
  19. End Sub
复制代码

PE005S.zip

12.17 KB, 下载次数: 12

发表于 2014-10-13 09:54 | 显示全部楼层
回复

使用道具 举报

发表于 2014-10-13 10:06 | 显示全部楼层
回复

使用道具 举报

 楼主| 发表于 2014-10-13 10:09 | 显示全部楼层
grf1973 发表于 2014-10-13 09:54
上个附件。

已上传
回复

使用道具 举报

 楼主| 发表于 2014-10-13 10:10 | 显示全部楼层
zjdh 发表于 2014-10-13 10:06
你不传附件,人家如何帮你?

新人,不懂,现已上传
回复

使用道具 举报

发表于 2014-10-13 10:32 | 显示全部楼层
nangongyixun 发表于 2014-10-13 10:10
新人,不懂,现已上传

如果是新人,建议明细表添加个辅助列,字段名为类型,分为标准,零部,信用等,这样筛选会不容易错,筛选结果放哪里都可以
回复

使用道具 举报

发表于 2014-10-13 10:32 | 显示全部楼层    本楼为最佳答案   
  1. Sub tt()
  2.     Dim Rng1 As Range, Rng2 As Range, Rng3 As Range
  3.     Dim Rng As Range
  4.     r = [a65536].End(3).Row
  5.     For i = 5 To r
  6.         th = Trim(Cells(i, 2))
  7.         Set Rng = Cells(i, 1).Resize(1, 7)
  8.         If th Like "GB*" Then
  9.             If Rng1 Is Nothing Then Set Rng1 = Rng Else Set Rng1 = Union(Rng1, Rng)
  10.         ElseIf th = Trim([a2]) Then
  11.             If Rng2 Is Nothing Then Set Rng2 = Rng Else Set Rng2 = Union(Rng2, Rng)
  12.         ElseIf Len(th) > 0 Then
  13.             If Rng3 Is Nothing Then Set Rng3 = Rng Else Set Rng3 = Union(Rng3, Rng)
  14.         End If
  15.     Next
  16.     Rng1.Copy Sheet2.[a5]
  17.     Rng2.Copy Sheet3.[a5]
  18.     Rng3.Copy Sheet4.[a5]
  19. End Sub
复制代码
回复

使用道具 举报

发表于 2014-10-13 10:36 | 显示全部楼层
请看附件。

PE005S.rar

20.47 KB, 下载次数: 17

回复

使用道具 举报

发表于 2014-10-13 10:36 | 显示全部楼层
PE005S.rar (15.67 KB, 下载次数: 3)
回复

使用道具 举报

 楼主| 发表于 2014-10-13 10:50 | 显示全部楼层
grf1973 发表于 2014-10-13 10:36
请看附件。

为什么明细表中名称一栏输入内容后,无法在后面的表单中显示?
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 13:34 , Processed in 0.652445 second(s), 14 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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