[已解决]下标越界怎么改呀

武林长风 · 发表于 2015-7-13 11:21

下面代码运行时，提示：
下标越界9，
br(m, j) = ar(i, j)，显示黄色字体。
原代码：
Sub drcj()
Dim wb1 As Workbook, wb2 As Workbook, ar, br, lr
Application.ScreenUpdating = 0
fpath$ = ThisWorkbook.Path & "\各校成绩单\"
fname$ = Dir(fpath & "*.xls")
Set wb1 = ThisWorkbook
Do While fname <> ""
      Set wb2 = Workbooks.Open(fpath & fname)
      ar = wb2.Sheets(1).[a1].CurrentRegion
      wb2.Close False
      For Each t In Array("*一年*", "*二年*", "*三年*", "*四年*", "*五年*", "*六年*")
         ReDim br(1 To UBound(ar), 1 To 9)
         For i = 3 To UBound(ar)
            If ar(i, 2) Like t Then
                  m = m + 1
                  For j = 1 To UBound(ar, 2)
                     br(m, j) = ar(i, j)
                  Next
            End If
         Next
         lr = wb1.Sheets(Mid(t, 2, 2) & "级").[a65536].End(3).Row + 1
         wb1.Sheets(Mid(t, 2, 2) & "级").Cells(lr, 1).Resize(m, 9) = br
         m = 0
      Next
      fname = Dir
Loop
Application.ScreenUpdating = 1
End Sub

最佳答案

月排行榜 / 总排行榜

qh8600

2015-7-13 13:40

武林长风发表于 2015-7-13 12:22

你文件夹的表格的列数不是一样的哈
已修改

导入成绩单.rar (388.2 KB, 下载次数: 4)

qh8600 · 发表于 2015-7-13 11:25

F8调试一下就可以了

武林长风 · 发表于 2015-7-13 11:41

还是不能上传附件。

武林长风 · 发表于 2015-7-13 11:42

qh8600 发表于 2015-7-13 11:25
F8调试一下就可以了

F8调试后：br(m, j) = ar(i, j)，高亮。

爱疯 · 发表于 2015-7-13 11:43

还是不能上传附件，提示什么？

武林长风 · 发表于 2015-7-13 11:45

武林长风发表于 2015-7-13 11:42
F8调试后：br(m, j) = ar(i, j)，高亮。

点附件，没看到浏览上传附件的选项，空白，换浏览器也是一样。

武林长风 · 发表于 2015-7-13 11:46

爱疯发表于 2015-7-13 11:43
还是不能上传附件，提示什么？

截图也上传不了。

qh8600 · 发表于 2015-7-13 11:53

武林长风发表于 2015-7-13 11:42
F8调试后：br(m, j) = ar(i, j)，高亮。

看参数啊，那个参数溢出了

武林长风 · 发表于 2015-7-13 12:22

爱疯发表于 2015-7-13 11:43
还是不能上传附件，提示什么？

导入成绩单.rar (388.05 KB, 下载次数: 2)

qh8600 · 发表于 2015-7-13 13:40

这个最佳答案由 qh8600 给出，感谢 qh8600 的回答。

单击隐藏图章

武林长风发表于 2015-7-13 12:22

你文件夹的表格的列数不是一样的哈
已修改

导入成绩单.rar (388.2 KB, 下载次数: 4)

		自动登录	找回密码
密码			注册