[已解决]快速提取列数据。

可爱的小鱼

快速提取sheet1表里B,M,X,列里数据到sheet2。

最佳答案

月排行榜 / 总排行榜

柳如烟

2012-8-19 08:25

1. 
   
2. Sub 快速提取()
   
3.     Dim a, arr(), i%
   
4.     a = Sheet1.Range("a1").CurrentRegion
   
5.     ReDim arr(1 To UBound(a), 1 To 3)
   
6.     For i = 1 To UBound(a)
   
7.         arr(i, 1) = a(i, 2)
   
8.         arr(i, 2) = a(i, 13)
   
9.         arr(i, 3) = a(i, 24)
   
10.     Next
    
11.     With Sheet2
    
12.         .Cells.ClearContents
    
13.         .Range("a1").Resize(i - 1, 3) = arr
    
14.         If MsgBox("提取完成,要查看结果吗?", vbQuestion + vbYesNo) = vbYes Then .Select
    
15.     End With
    
16. End Sub
    

复制代码

跳转到最佳答案楼层

pogy

用=号就可以，请看例子

hwc2ycy

1. 
   
2. Sub c1()
   
3.     Application.ScreenUpdating = False
   
4.     Dim myr As Long
   
5.     myr = Range("b1").End(xlDown).Row
   
6. '    Range("b1:b" & myr).Copy Destination:=Worksheets("Sheet2").Range("a1")
   
7. '    Range("m1:m" & myr).Copy Destination:=Worksheets("Sheet2").Range("b1")
   
8. '    Range("x1:x" & myr).Copy Destination:=Worksheets("Sheet2").Range("c1")
   
9.     Range("b:b").Copy Destination:=Worksheets("Sheet2").Range("a:a")
   
10.     Range("m:m").Copy Destination:=Worksheets("Sheet2").Range("b:b")
    
11.     Range("x:x").Copy Destination:=Worksheets("Sheet2").Range("c:c")
    
12.     Application.ScreenUpdating = True
    
13. End Sub
    

复制代码

qgs2012

实现方法应该有很多的

柳如烟

1. 
   
2. Sub 快速提取()
   
3.     Dim a, arr(), i%
   
4.     a = Sheet1.Range("a1").CurrentRegion
   
5.     ReDim arr(1 To UBound(a), 1 To 3)
   
6.     For i = 1 To UBound(a)
   
7.         arr(i, 1) = a(i, 2)
   
8.         arr(i, 2) = a(i, 13)
   
9.         arr(i, 3) = a(i, 24)
   
10.     Next
    
11.     With Sheet2
    
12.         .Cells.ClearContents
    
13.         .Range("a1").Resize(i - 1, 3) = arr
    
14.         If MsgBox("提取完成,要查看结果吗?", vbQuestion + vbYesNo) = vbYes Then .Select
    
15.     End With
    
16. End Sub
    

复制代码

JLxiangwei

1. Sub tiqu()
   
2.     Dim arr, x
   
3.     arr = Sheet1.Range("a1").CurrentRegion
   
4.     x = UBound(arr)
   
5.     With Sheet2
   
6.         .Cells.ClearContents
   
7.         .Range("a1").Resize(x, 1) = Application.Index(arr, , 2)
   
8.         .Range("b1").Resize(x, 1) = Application.Index(arr, , 13)
   
9.         .Range("c1").Resize(x, 1) = Application.Index(arr, , 24)
   
10.     End With
    
11. End Sub
    

复制代码

直接调用函数，不用循环简单一点。
订单.zip (14.78 KB, 下载次数: 7)

2012-8-19 09:21 上传

点击文件名下载附件

JLxiangwei

呵呵，index是慢，数据量很小的时候，用它很方便，不用去循环赋值