设为首页收藏本站
开启辅助访问

Excel精英培训网

 找回密码
 注册
Excel精英培训网»论坛 › Excel 求助区 › Excel VBA开发 › 把同行数据提取到一起
数据透视表40+个常用小技巧，让你一次学会！
12下一页
返回列表 发新帖
查看: 3825|回复: 10

[已解决]把同行数据提取到一起

[复制链接]
发表于 2014-12-29 15:22 | 显示全部楼层 |阅读模式
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
本帖最后由 meet10010 于 2014-12-29 15:30 编辑

把同行数据提取到一起.
明明上传了附件的。现已重新上传。
最佳答案
月排行榜 / 总排行榜
grf1973
2014-12-29 16:25
带格式的更简单，速度慢一点：
  1. Sub tt()
  2.     Sheet11.Cells.Clear
  3.     For k = 1 To 10
  4.         For i = 19 To 43
  5.             If i = 19 Then n = k Else n = n + 11
  6.             Sheets("Sheet" & k).Cells(i, 2).Resize(1, 188).Copy Sheet11.Cells(n, 1)
  7.         Next
  8.     Next
  9. End Sub
复制代码

提取相同行数据到一起.rar

174.42 KB, 下载次数: 15
excel精英培训的微信平台，每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
回复

使用道具 举报

工作中最常用的函数公式，全印在一张超大的鼠标垫上
baksy
发表于 2014-12-29 15:24 | 显示全部楼层
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
请上传附件。
回复

使用道具 举报

qh8600
发表于 2014-12-29 15:57 | 显示全部楼层
工作中最常用的Excel函数公式，全印在一张鼠标垫上
提取相同行数据到一起.rar (314.55 KB, 下载次数: 12)
回复

使用道具 举报

 楼主| 发表于 2014-12-29 16:03 | 显示全部楼层
qh8600 发表于 2014-12-29 15:57
楼主试试


谢谢老师，可否把格式一起复制过来。那个填充的底红色也要粘贴过来。
回复

使用道具 举报

grf1973
发表于 2014-12-29 16:12 | 显示全部楼层
  1. Sub tt()
  2.     Dim brr(1 To 500, 1 To 200)
  3.     For k = 1 To 10
  4.         arr = Sheets("Sheet" & k).[b19:gg43]
  5.         For i = 1 To UBound(arr)
  6.             If i = 1 Then n = k Else n = n + 11
  7.             For j = 1 To UBound(arr, 2)
  8.                 brr(n, j) = arr(i, j)
  9.             Next
  10.         Next
  11.     Next
  12.     Sheet11.Cells.ClearContents
  13.     Sheet11.[a1].Resize(n, UBound(arr, 2)) = brr
  14. End Sub
复制代码
回复

使用道具 举报

grf1973
发表于 2014-12-29 16:13 | 显示全部楼层
请看附件。

提取相同行数据到一起.rar

185.4 KB, 下载次数: 11
回复

使用道具 举报

 楼主| 发表于 2014-12-29 16:13 | 显示全部楼层
grf1973 发表于 2014-12-29 16:12

需要把红底色一起粘贴过来。
回复

使用道具 举报

发表于 2014-12-29 16:15 | 显示全部楼层
  1. Sub test1()
  2. Dim i%, rw&
  3.   Sheets(11).Cells.Clear
  4.   For n = 19 To 43
  5.    For i = 1 To 10
  6.      Sheets(i).Rows(n).Copy Sheets(11).Range("A" & rw + 1)
  7.      rw = Sheets(11).Cells(Rows.Count, 2).End(3).Row
  8.    Next
  9.   Next
  10.   MsgBox ("Sheets1-Sheets10的数据全部复制完毕！")
  11.   Sheets(11).Activate
  12. End Sub
复制代码
回复

使用道具 举报

发表于 2014-12-29 16:18 | 显示全部楼层
本帖最后由 ppp710715 于 2014-12-29 16:21 编辑
  1. Sub test1()
  2. Dim i%, rw&
  3.   Sheets(11).Cells.Clear
  4.   For n = 19 To 43
  5.    For i = 1 To 10
  6.      Sheets(i).Rows(n).Copy Sheets(11).Range("A" & rw + 1)
  7.      rw = Sheets(11).Cells(Rows.Count, 2).End(3).Row
  8.    Next
  9.   Next
  10.   MsgBox ("Sheets1-Sheets10的数据全部复制完毕！")
  11.   Sheets(11).Activate
  12.   Sheets(11).[a1:gg1].EntireColumn.AutoFit
  13. End Sub 同行数据提取到一起.rar (352.29 KB, 下载次数: 5)
复制代码
回复

使用道具 举报

grf1973
发表于 2014-12-29 16:25 | 显示全部楼层    本楼为最佳答案   
带格式的更简单，速度慢一点：
  1. Sub tt()
  2.     Sheet11.Cells.Clear
  3.     For k = 1 To 10
  4.         For i = 19 To 43
  5.             If i = 19 Then n = k Else n = n + 11
  6.             Sheets("Sheet" & k).Cells(i, 2).Resize(1, 188).Copy Sheet11.Cells(n, 1)
  7.         Next
  8.     Next
  9. End Sub
复制代码
回复

使用道具 举报

下一页 »
12下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-4-26 20:55 , Processed in 0.861881 second(s), 11 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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