Excel精英培训网

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

[已解决]提取的数据按指定行数放置,哪位老师能赐教一下,谢谢!

[复制链接]
发表于 2017-1-11 21:39 | 显示全部楼层 |阅读模式
老师好!
怎样提取A:C列和R:S列的数据到表二的A3以下的指定行数的区域里(行数必需是能动态指定的,比如可能统一35行或者统一40行,根据需要来决定)。
不知老师能否帮忙一下?先谢啦!

最佳答案
2017-1-13 01:15
本帖最后由 today0427 于 2017-1-13 08:33 编辑

大师是什么鬼?不要乱叫 答案显示在sheet3表中

  1. Sub today()
  2.     Dim n%, arr, i&, brr(), zls%
  3.     Call qc
  4.     n = Application.InputBox("ÇëêäèëÖ¸¶¨DDêy", "ìáê¾", 40, , , , , 1)
  5.     If n = 0 Then Exit Sub
  6.     arr = Sheet1.Range("a4:x" & Sheet1.[c65536].End(3).Row)
  7.     zls = 5 * Application.Ceiling(UBound(arr) / n, 1)
  8.     ReDim brr(1 To n, 1 To zls)
  9.     co = 1
  10.     For i = 1 To UBound(arr)
  11.         ro = ro + 1
  12.         If ro > n Then ro = 1: co = co + 5
  13.         brr(ro, co) = arr(i, 1): brr(ro, co + 1) = arr(i, 2): brr(ro, co + 2) = arr(i, 3)
  14.         brr(ro, co + 3) = arr(i, 18): brr(ro, co + 4) = arr(i, 19)
  15.     Next
  16.     With Sheet3
  17.         Sheet2.Range("a2:e2").Copy .[a2].Resize(1, zls)
  18.         .[a3].Resize(n, zls) = brr
  19.         .Activate
  20.     End With
  21. End Sub
  22. Sub qc()
  23.     Sheet3.UsedRange.ClearContents
  24. End Sub
复制代码


提取的数据按指定行数放置.zip

20.92 KB, 下载次数: 12

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2017-1-11 22:20 | 显示全部楼层
回复

使用道具 举报

发表于 2017-1-11 23:14 | 显示全部楼层
回复

使用道具 举报

 楼主| 发表于 2017-1-12 10:01 | 显示全部楼层
谢谢today0427大师的关注和赐教!
      表二现有的数据是示例,就是说表二的A:E列放置40行,F:J列放置40行,K:O列放置40行,A:E列放置40行,P:T列放置40行......以此类推。
      大师能否帮忙下?先谢啦!
回复

使用道具 举报

发表于 2017-1-13 01:15 | 显示全部楼层    本楼为最佳答案   
本帖最后由 today0427 于 2017-1-13 08:33 编辑

大师是什么鬼?不要乱叫 答案显示在sheet3表中

  1. Sub today()
  2.     Dim n%, arr, i&, brr(), zls%
  3.     Call qc
  4.     n = Application.InputBox("ÇëêäèëÖ¸¶¨DDêy", "ìáê¾", 40, , , , , 1)
  5.     If n = 0 Then Exit Sub
  6.     arr = Sheet1.Range("a4:x" & Sheet1.[c65536].End(3).Row)
  7.     zls = 5 * Application.Ceiling(UBound(arr) / n, 1)
  8.     ReDim brr(1 To n, 1 To zls)
  9.     co = 1
  10.     For i = 1 To UBound(arr)
  11.         ro = ro + 1
  12.         If ro > n Then ro = 1: co = co + 5
  13.         brr(ro, co) = arr(i, 1): brr(ro, co + 1) = arr(i, 2): brr(ro, co + 2) = arr(i, 3)
  14.         brr(ro, co + 3) = arr(i, 18): brr(ro, co + 4) = arr(i, 19)
  15.     Next
  16.     With Sheet3
  17.         Sheet2.Range("a2:e2").Copy .[a2].Resize(1, zls)
  18.         .[a3].Resize(n, zls) = brr
  19.         .Activate
  20.     End With
  21. End Sub
  22. Sub qc()
  23.     Sheet3.UsedRange.ClearContents
  24. End Sub
复制代码


提取的数据按指定行数放置.rar

58.21 KB, 下载次数: 14

评分

参与人数 3 +34 金币 +30 收起 理由
望帝春心 + 30 + 30 来学习~我好像不能评最佳...
wtb2d815 + 1 很给力
laoau138 + 3 来学习

查看全部评分

回复

使用道具 举报

发表于 2017-1-13 23:02 | 显示全部楼层
today0427 发表于 2017-1-13 01:15
大师是什么鬼?不要乱叫 答案显示在sheet3表中

VBA看图片规则计算A列结果

http://www.excelpx.com/thread-427160-1-1.html


回复

使用道具 举报

 楼主| 发表于 2017-1-24 11:05 | 显示全部楼层
谢谢today0427老师热心相助!
该求助本以为无望,所以没再回头查看,没想到在老师的不懈关心下给解决了,高手啊,热心的好人!谢谢!
回复

使用道具 举报

发表于 2017-1-24 17:06 | 显示全部楼层
today0427 发表于 2017-1-13 01:15
大师是什么鬼?不要乱叫 答案显示在sheet3表中

VBA判断数字在第几个区间



http://www.excelpx.com/thread-427348-1-1.html


回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 14:39 , Processed in 0.430406 second(s), 15 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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