Excel精英培训网

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

[已解决]提取条件需要数据

[复制链接]
发表于 2012-8-20 05:42 | 显示全部楼层 |阅读模式
提取条件数据
最佳答案
2012-8-20 08:03
提取需要数据.rar (11.68 KB, 下载次数: 34)

提取需要数据.zip

13.61 KB, 下载次数: 21

发表于 2012-8-20 08:03 | 显示全部楼层    本楼为最佳答案   
提取需要数据.rar (11.68 KB, 下载次数: 34)
回复

使用道具 举报

发表于 2012-8-20 08:09 | 显示全部楼层
数据维数不能弄错,既然你要5列数据,上面的arra1定义应该是2行5列,下面的RESIZE也得是5列,才能达到你的要求。

  1. Option Explicit
  2. Sub 数组提取()
  3.     Dim arr1(1 To 2, 1 To 5), i, j, arr, k
  4.     With Sheet2
  5.         arr = Range("A5:f" & Range("A65536").End(3).Row + 1)
  6.     End With
  7.     k = k + 1
  8.     For i = 1 To UBound(arr)
  9.      'MsgBox arr(i, 1) = Sheet1.Range("A6")
  10.         If arr(i, 1) = Sheet1.Range("A6") Then
  11.             arr1(k, 1) = arr(i, 1)
  12.             'arr1(2, 1) = arr(i - 1, 1)
  13.             For j = 2 To 5
  14.                 arr1(k, j) = arr(i, j)
  15.                 'arr1(2, j + 2) = arr(i - 1, j)
  16.             Next
  17.             k = k + 1
  18.             
  19.         Else
  20.         If arr(i, 1) = Sheet1.Range("A5") Then
  21.             arr1(k, 1) = arr(i, 1)
  22.             'arr1(2, 1) = arr(i - 1, 1)
  23.             For j = 2 To 5
  24.                 arr1(k, j) = arr(i, j)
  25.                 'arr1(2, j + 2) = arr(i - 1, j)
  26.             Next
  27.             k = k + 1
  28.         End If
  29.     End If
  30. Next


  31.     Sheets("sheet2").Range("l:p").Clear
  32.     Sheets("sheet2").Range("l5").Resize(UBound(arr1), 5) = arr1
  33. End Sub
复制代码

评分

参与人数 1 +5 金币 +5 收起 理由
suye1010 + 5 + 5 赞一个!

查看全部评分

回复

使用道具 举报

发表于 2012-8-20 08:11 | 显示全部楼层
回过贴看过来一看,居然把代码回到别的贴了,
回复

使用道具 举报

发表于 2012-10-27 16:58 | 显示全部楼层
不错,又能学习啦!
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 23:56 , Processed in 0.683947 second(s), 14 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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