[已解决]用VBA从下往上提取多少行 改写用数组

laoau138

用VBA从下往上提取多少行  改写用数组

最佳答案

月排行榜 / 总排行榜

yorkchenshunan

2017-6-5 09:50

1. Sub loarr()
   
2.     Dim arr, brr, i%, j%
   
3.     arr = Range("a1").CurrentRegion
   
4.    
   
5.     If [h1] > UBound(arr) Then Exit Sub
   
6.    
   
7.     [j1].CurrentRegion.ClearContents '清屏
   
8.    
   
9.     ReDim brr(1 To [h1], 1 To UBound(arr, 2))
   
10.    
    
11.     For i = UBound(arr) - [h1] + 1 To UBound(arr)
    
12.         For j = 1 To UBound(arr, 2)
    
13.             brr(i - UBound(arr) + [h1], j) = arr(i, j)
    
14.         Next j
    
15.     Next i
    
16.    
    
17.     [j1].Resize(UBound(brr), UBound(brr, 2)) = brr
    
18.    
    
19.     '刷格式
    
20.     Range("a1:e1").Copy
    
21.     Range("j1").CurrentRegion.PasteSpecial xlPasteFormats
    
22.    
    
23. End Sub

复制代码

跳转到最佳答案楼层

zhxl0562

chart888

zhxl0562 发表于 2017-6-5 09:11

1. Sub test1()
   
2. Dim r, h
   
3. Dim arr()
   
4. r = Sheet1.Range("A65536").End(xlUp).Row
   
5. h = Sheet1.Range("A65536").End(xlUp).Row - Sheet1.Range("h1").Value+1
   
6. 
   
7. arr = Sheet1.Range("a" & h & ":e" & r)
   
8. Sheet1.Range("j:n") = ""
   
9. Range("j1").Resize(r - h+1, 5) = arr
   
10. End Sub

复制代码

应该再加1行

yorkchenshunan

1. Sub loarr()
   
2.     Dim arr, brr, i%, j%
   
3.     arr = Range("a1").CurrentRegion
   
4.    
   
5.     If [h1] > UBound(arr) Then Exit Sub
   
6.    
   
7.     [j1].CurrentRegion.ClearContents '清屏
   
8.    
   
9.     ReDim brr(1 To [h1], 1 To UBound(arr, 2))
   
10.    
    
11.     For i = UBound(arr) - [h1] + 1 To UBound(arr)
    
12.         For j = 1 To UBound(arr, 2)
    
13.             brr(i - UBound(arr) + [h1], j) = arr(i, j)
    
14.         Next j
    
15.     Next i
    
16.    
    
17.     [j1].Resize(UBound(brr), UBound(brr, 2)) = brr
    
18.    
    
19.     '刷格式
    
20.     Range("a1:e1").Copy
    
21.     Range("j1").CurrentRegion.PasteSpecial xlPasteFormats
    
22.    
    
23. End Sub

复制代码

laoau138

yorkchenshunan 发表于 2017-6-5 09:50

大侠   好长时间没有见过你

laoau138

yorkchenshunan 发表于 2017-6-5 09:50

用VBA打开同一路径下2个工作簿 改写插入一行

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