[已解决]公式运行提示下标越界，请老师帮忙看下。。

tzjx200521

如附件所示，，运行VB的时候提示下标越界。。。不知道什么原因，请老师帮忙看下。。麻烦了。

最佳答案

月排行榜 / 总排行榜

hrpotter

2012-3-9 14:27

1. Sub a()
   
2.     Dim i As Long, j As Long, sh As Worksheet, arr(1 To 10000, 1 To 4)
   
3.     Dim i1 As Long, i2 As Long
   
4.     With Worksheets("合并竖表")
   
5.     .Range("a1").CurrentRegion.ClearContents
   
6.     For Each sh In Worksheets
   
7.         If sh.Name <> "合并竖表" Then
   
8.             i = sh.[b65536].End(3).Row + 1
   
9.             j = sh.[iv1].End(xlToLeft).Column
   
10.             For i1 = 1 To i / 5
    
11.                 For i2 = 2 To j
    
12.                     k = k + 1
    
13.                     arr(k, 1) = sh.Cells((i1 - 1) * 5 + 1, i2)
    
14.                     arr(k, 2) = sh.Cells((i1 - 1) * 5 + 2, i2)
    
15.                     arr(k, 3) = sh.Cells((i1 - 1) * 5 + 3, i2)
    
16.                     arr(k, 4) = sh.Cells((i1 - 1) * 5 + 4, i2)
    
17.                 Next i2
    
18.             Next i1
    
19.             .[a65536].End(3).Offset(1, 0).Resize(k, 4) = arr
    
20.             k = 0
    
21.             Erase arr
    
22.         End If
    
23.     Next sh
    
24.     .Rows(1).Delete
    
25.     End With
    
26. End Sub
    

复制代码

去掉ReDim arr(1 To i / 5 * j, 1 To 4),直接定义成一个足够大的数组arr(1 To 10000, 1 To 4)

跳转到最佳答案楼层

hrpotter

1. Sub a()
   
2.     Dim i As Long, j As Long, sh As Worksheet, arr(1 To 10000, 1 To 4)
   
3.     Dim i1 As Long, i2 As Long
   
4.     With Worksheets("合并竖表")
   
5.     .Range("a1").CurrentRegion.ClearContents
   
6.     For Each sh In Worksheets
   
7.         If sh.Name <> "合并竖表" Then
   
8.             i = sh.[b65536].End(3).Row + 1
   
9.             j = sh.[iv1].End(xlToLeft).Column
   
10.             For i1 = 1 To i / 5
    
11.                 For i2 = 2 To j
    
12.                     k = k + 1
    
13.                     arr(k, 1) = sh.Cells((i1 - 1) * 5 + 1, i2)
    
14.                     arr(k, 2) = sh.Cells((i1 - 1) * 5 + 2, i2)
    
15.                     arr(k, 3) = sh.Cells((i1 - 1) * 5 + 3, i2)
    
16.                     arr(k, 4) = sh.Cells((i1 - 1) * 5 + 4, i2)
    
17.                 Next i2
    
18.             Next i1
    
19.             .[a65536].End(3).Offset(1, 0).Resize(k, 4) = arr
    
20.             k = 0
    
21.             Erase arr
    
22.         End If
    
23.     Next sh
    
24.     .Rows(1).Delete
    
25.     End With
    
26. End Sub
    

复制代码

去掉ReDim arr(1 To i / 5 * j, 1 To 4),直接定义成一个足够大的数组arr(1 To 10000, 1 To 4)

tzjx200521

  谢谢老师啊。。。可以了。。