Excel精英培训网

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

[已解决]历遍工作表提取合格数据的问题

[复制链接]
发表于 2015-5-6 13:16 | 显示全部楼层 |阅读模式
本帖最后由 李全有 于 2015-5-6 14:44 编辑

附件 历遍工作表提取合格数据附件.zip (466.52 KB, 下载次数: 14)
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2015-5-6 14:31 | 显示全部楼层    本楼为最佳答案   
  1. Sub grf()
  2.     k = -3
  3.     For Each sh In Worksheets
  4.         If sh.Index > 1 Then
  5.             c = sh.UsedRange.Columns.Count
  6.             For j = 1 To c Step 4
  7.                 arr = sh.Cells(1, j).CurrentRegion
  8.                 Set Rng = sh.Columns(j + 1).Find(0, lookat:=xlWhole)
  9.                 If Not Rng Is Nothing Then
  10.                     r = Rng.Row
  11.                     If r > 3 Then
  12.                         If arr(r, 1) = arr(r - 1, 1) And arr(r, 1) = arr(r - 2, 1) Then
  13.                             k = k + 4
  14.                             Cells(24, k).Resize(UBound(arr), 3) = arr
  15.                             Cells(24 + UBound(arr) + 1, k) = sh.Name & "-" & j
  16.                         End If
  17.                     End If
  18.                 End If
  19.             
  20.             Next
  21.         End If
  22.     Next
  23. End Sub
复制代码

历遍工作表提取合格数据附件.rar

477.23 KB, 下载次数: 16

评分

参与人数 1 +1 收起 理由
李全有 + 1 谢谢老师!

查看全部评分

回复

使用道具 举报

发表于 2015-5-6 14:46 | 显示全部楼层
回复

使用道具 举报

 楼主| 发表于 2015-5-6 16:32 | 显示全部楼层
grf1973 发表于 2015-5-6 14:46
第11句应该是r>=3

老师你好,我如果想提2个以上(包括2个)的,把代码里面的  3  改为2,行吗?代码里一共有3个3。

谢谢老师。
回复

使用道具 举报

发表于 2015-5-6 16:41 | 显示全部楼层
If r > =2 Then
                        If arr(r, 1) = arr(r - 1, 1)  Then
回复

使用道具 举报

发表于 2015-5-6 16:42 | 显示全部楼层
第11 第12句这样改就行了。
回复

使用道具 举报

 楼主| 发表于 2015-5-6 16:56 | 显示全部楼层
grf1973 发表于 2015-5-6 16:42
第11 第12句这样改就行了。

谢谢!
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 09:49 , Processed in 0.592833 second(s), 15 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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