|
下面代码运行时,提示:
下标越界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
武林长风 发表于 2015-7-13 12:22
你文件夹的表格的列数不是一样的哈
已修改
导入成绩单.rar
(388.2 KB, 下载次数: 4)
|
|