请老师帮忙看看我的代码哪里有问题

Tibetzp

Sub test()
  Dim r%, i%
  Dim arr, brr(1 To 1000, 1 To 80)
  Dim mypath$, myname$
  mypath = ThisWorkbook.Path & "\课时量\"
  myname = Dir(mypath & "*.xls")
  m = 0
  Do While myname <> ""
    Set wb = GetObject(mypath & myname)
    With wb
      With .Worksheets("本（专）科")
        arr = .Range("a1:o88")
        m = m + 1
        brr(m, 1) = myname
        i = 2
        n = i
        brr(m, n) = arr(i, 2)
        brr(m, n + 1) = arr(i, 4)
        brr(m, n + 2) = arr(i, 7)
        brr(m, n + 3) = arr(i, 11)
        brr(m, n + 4) = arr(i, 14)
  '读取教师信息
        For j = 7 To 17
          g = j - 2
          brr(m, j) = arr(g, 15)
  '读取课程教学课时量
  Next
        For j = 18 To 28
         g = j + 2
          brr(m, j) = arr(g, 15)
'读取实践教学课时量
  Next
        For j = 29 To 35
         g = j + 4
          brr(m, j) = arr(g, 15)
'读取指导实习课时量
         j = 36
         g = j + 7
          brr(m, j) = arr(g, 15)
'读取指导毕业论文课时量
         j = 37
         g = j + 10
         brr(m, j) = arr(g, 15)
'读取毕业论文答辩课时量
         j = 38
         g = j + 21
          brr(m, j) = arr(g, 15)
'读取监考课时量
Next
        For j = 39 To 44
         g = j + 24
        brr(m, j) = arr(g, 13)
'读取指导大创课时量
Next
        For j = 45 To 50
          g = j + 26  
          brr(m, j) = arr(g, 13)
'读取指导课外科技活动课时量
Next
        For j = 51 To 53
         g = j + 27
          brr(m, j) = arr(g, 15)
'读取教研等课时量
        Next
      End With
      .Close False
    End With
    myname = Dir
  Loop
  With Worksheets("sheet1")
    .UsedRange.Offset(2, 0).ClearContents
    .Range("a2").Resize(m, UBound(brr, 2)) = brr
  End With
End Sub


诉求：1、工作簿大约有400份左右；
           2、        For j = 7 To 17
          g = j - 2
          brr(m, j) = arr(g, 15)
  '读取课程教学课时量
这个位置能自动统计到汇总表存在一列上吗？如果能，我就不用填写那么多列了。

liulang0808

With .Worksheets("本（专）科")
要保证每个被遍历到的工作薄都有这张表的，没有的肯定报错的，楼主检查下就知道了
本（专）科（2018-2019（1））

Tibetzp

谢谢版主解释，我查看一下。

Tibetzp

还是不行，请老师帮我看看为什么遍历不下去。

liulang0808

Tibetzp 发表于 2019-10-4 16:55
还是不行，请老师帮我看看为什么遍历不下去。

之前看了有的工作薄没有指定表名的工作表
楼主都修改完成的话，还有问题，建议更新下需求附件吧

Tibetzp

已更新，请老师们有空时帮我看下。