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

李全有

附件 历遍工作作提取列数据.zip (63.08 KB, 下载次数: 3)

2015-5-2 08:24 上传

点击文件名下载附件
谢谢！

最佳答案

月排行榜 / 总排行榜

qh8600

2015-5-2 09:30

历遍工作作提取列数据.rar (74.88 KB, 下载次数: 18)

2015-5-2 09:29 上传

点击文件名下载附件
楼主试试

跳转到最佳答案楼层

qh8600

1. Sub demo()
   
2.     Dim ar, br(), m, x, i, n, s
   
3.     m = Sheets.Count - 1
   
4.     ReDim br(1 To 10000, 1 To m * 4)
   
5.     For x = 1 To m + 1
   
6.         If Sheets(x).Name <> "Sheet0" Then
   
7.             s = s + 1: n = s * 4 - 3
   
8.             ar = Sheets(x).Range("a1:q" & Sheets(x).Cells(Rows.Count, 1).End(3).Row)
   
9.             For i = 1 To UBound(ar)
   
10.                 br(i, n) = ar(i, 3)
    
11.                 br(i, n + 1) = ar(i, 11)
    
12.                 br(i, n + 2) = ar(i, 17)
    
13.             Next
    
14.         End If
    
15.     Next
    
16.     Sheets("Sheet0").Range("a1").Resize(UBound(br), UBound(br, 2)) = br
    
17. End Sub

复制代码

附件楼下

qh8600

历遍工作作提取列数据.rar (74.88 KB, 下载次数: 18)

2015-5-2 09:29 上传

点击文件名下载附件
楼主试试